+Sanity cleanup handler for destroying: $W

$WebConfig{"web_hostname"} is now optional.
-$ENV{"HOSTNAME"} setting dropped; no reason known for it.
+&a_href_inhibit for using &a_href before $W initialization (without URIs).
+Support for: $W->{"css_push"}

diff --git a/Web.pm b/Web.pm
index 3eb176b..dcd40ea 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -39,6 +39,9 @@ our @EXPORT=qw(
                );
 our @ISA=qw(Tie::Handle Exporter);
 
+my %packages_used_hash;
+my %packages_used_array;
+
 BEGIN
 {
        use Carp qw(cluck confess);
@@ -63,8 +66,8 @@ BEGIN
                for my $target ($class,__PACKAGE__) {
                        for my $caller (keys(%callers)) {
                                next if $caller eq $target;
-                               next if $W->{'packages_used%'}{$caller}{$target}++;
-                               push @{$W->{'packages_used@'}{$caller}},$target;
+                               next if $packages_used_hash{$caller}{$target}++;
+                               push @{$packages_used_array{$caller}},$target;
                                }
                        }
                eval { CORE::require "$file"; } or confess $@;
@@ -106,7 +109,7 @@ my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; }
 # I do not know why.
 use POSIX qw(strftime);
 use Tie::Handle;
-use Apache2::Const qw(HTTP_MOVED_TEMPORARILY);
+use Apache2::Const qw(HTTP_MOVED_TEMPORARILY OK);
 use URI;
 use URI::QueryParam;
 use Cwd;
@@ -120,10 +123,17 @@ use Cwd;
                # $W->{"footer_passed"}
                # %{$W->{"headers"}}
                # %{$W->{"headers_lc"}} # maps lc($headers_key)=>$headers_key
-               # @{$W->{'packages_used@'}{callers...}}
-               # %{$W->{'packages_used%'}{callers...}}
                # %{$W->{"args"}}
 
+sub cleanup($)
+{
+my($apache_request)=@_;
+
+       # Sanity protection.
+       $W=undef();
+       return OK;
+}
+
 sub init ($%)
 {
 my($class,%args)=@_;
@@ -136,13 +146,9 @@ my($class,%args)=@_;
        Wuse 'WebConfig';
        Wrequire 'My::Hash::Sub';
 
-       my $packages_used_array_save=$W->{'packages_used@'};
-       my $packages_used_hash_save =$W->{'packages_used%'};
        $W={};
        tie %$W,"My::Hash::Sub";
        %$W=(%WebConfig,%args); # override %WebConfig settings
-       $W->{'packages_used@'}=$packages_used_array_save;
-       $W->{'packages_used%'}=$packages_used_hash_save;
        $W->{"__PACKAGE__"}||=caller();
 
        # {"__PACKAGE__"} is mandatory for mod_perl-2.0;
@@ -170,6 +176,10 @@ my($class,%args)=@_;
 
        $W->{"r"}=Apache2::RequestUtil->request();
 
+       $W->{"r"}->push_handlers("PerlCleanupHandler"=>\&cleanup);
+
+       $W->{"web_hostname"}||=$W->{"r"}->hostname();
+
        tie *STDOUT,$W->{"r"};
        select *STDOUT;
        $|=1;
@@ -218,8 +228,6 @@ my($class,%args)=@_;
 
        do { args_check(%$_) if $_; } for ($W->{"args_check"});
 
-       $ENV{"HOSTNAME"}||=$W->{"web_hostname"};
-
        return bless $W,$class;
 }
 
@@ -292,7 +300,7 @@ sub unparsed_uri()
                my $r=Apache2::RequestUtil->request();
                cluck "Calling ".'&unparsed_uri'." from a static code, going to fail" if !$r;
                my $uri_string=$r->unparsed_uri() or cluck "Valid 'r' missing unparsed_uri()?";
-               my $uri=URI->new_abs($uri_string,"http://".($W->{"web_hostname"}||$WebConfig{"web_hostname"})."/");
+               my $uri=URI->new_abs($uri_string,"http://".$W->{"web_hostname"}."/");
                $W->{"unparsed_uri"}=$uri;
                }
        return $W->{"unparsed_uri"};
@@ -315,6 +323,7 @@ my($in)=@_;
 }
 
 # $args{"uri_as_in"}=1 to permit passing URI objects as: $in
+# $args{"abs"}=1;
 sub path_web($%)
 {
 my($in,%args)=@_;
@@ -411,7 +420,7 @@ sub footer (;$)
 
        Wprint "<hr />\n" if $W->{"footer"};
 
-       my $packages_used=$W->{'packages_used@'}{$W->{"__PACKAGE__"}};
+       my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
 
        if ($W->{"footer_ids"}) {
                Wprint '<p class="cvs-id">';
@@ -519,6 +528,7 @@ my($uri)=@_;
        return escapeHTML(path_web('/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
 }
 
+our $a_href_inhibited;
 sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
@@ -531,6 +541,7 @@ my($in,$contents,%args)=@_;
                }
        $contents=~s#<a\b[^>]*>##gi;
        $contents=~s#</a>##gi;
+       return $contents if $a_href_inhibited;
 
        my $path_web=path_web $in,%args;
        my $r="";
@@ -547,6 +558,14 @@ my($in,$contents,%args)=@_;
        return $r;
 }
 
+sub a_href_inhibit($$;@)
+{
+my($self,$sub,@sub_args)=@_;
+
+       local $a_href_inhibited=1;
+       return &{$sub}(@sub_args);
+}
+
 sub input_hidden_persistents()
 {
        return join("",map({
@@ -820,14 +839,19 @@ my($class)=@_;
        Wprint '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
        Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$W->{"language"}.'">'."\n";
        my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
+       # Do not: cluck if $title=~/[<>]/;
+       # as it is not solved just by: &a_href_inhibit
+       # as sometimes titles use also: <i>...</i>
        $title=~s#<[^>]*>##g;
        Wprint "<head>";
        Wprint "<title>$title</title>\n";
        if ($W->{"have_css"}) {
                # Everything can get overriden later.
-               Wprint <<"HERE";
-<link rel="stylesheet" type="text/css" href="@{[ uri_escaped(path_web "/My/Web.css") ]}" />
+               for my $css ("/My/Web.css",map((!$_ ? () : ("ARRAY" ne ref($_) ? $_ : @$_)),$W->{"css_push"})) {
+                       Wprint <<"HERE";
+<link rel="stylesheet" type="text/css" href="@{[ uri_escaped(path_web $css) ]}" />
 HERE
+                       }
                }
        Wprint '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
        Wprint $W->{"head"};