X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=Web.pm;h=2a9406d750c84dc8c0f0d2ba21e1a3ee582d69e7;hb=fcaf410ca324e0fa3ad812545bf16e7bf4886b1e;hp=ad685e6ce502dd89638312b54326ca9d7d6d8325;hpb=a20ecc379dc3b96fc5646b3915022a9ffa399d9b;p=MyWeb.git diff --git a/Web.pm b/Web.pm index ad685e6..2a9406d 100644 --- a/Web.pm +++ b/Web.pm @@ -144,9 +144,11 @@ my($class,%args)=@_; Wrequire 'My::Hash'; # $W={} can get somehow created very easily. - cluck "W not empty:\n".Dumper($W) if keys(%$W); - $W=bless My::Hash->new({}),$class; - $W=My::Hash->new($W,"My::Hash::Sub","My::Hash::Push"); + # Do not: cluck "W not empty:\n".Dumper($W) if keys(%$W); + # to prevent (of $W->{"headers_in"}): TODO: Enumeration may not be expected. + cluck "W not empty; __PACKAGE__ was: ".$W->{"__PACKAGE__"} if keys(%$W); + $W=My::Hash->new({},"My::Hash::Sub","My::Hash::Push"); + bless $W,$class; %$W=( "__PACKAGE__"=>scalar(caller()), %WebConfig, @@ -260,11 +262,16 @@ my($class,%args)=@_; }; if (!defined $W->{"have_style"}) { - $W->{"have_style"}=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0); + $W->{"have_style"}=sub { + # Lazy-evaluation, we may not need the "User-Agent" header at all. + return our $r||=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0); + }; } $W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0); if ($W->{"detect_js"} && !$W->{"have_js"}) { + # Do not: '."\n"; } @@ -299,7 +306,7 @@ sub exit_hook } sub exit_hook_start { - cluck "exit_hook_start() twice?" if defined $exit_orig; + do { cluck "exit_hook_start() twice?"; return; } if defined $exit_orig; $exit_orig=\&CORE::GLOBAL::exit; # Prevent: Subroutine CORE::GLOBAL::exit redefined no warnings 'redefine'; @@ -309,7 +316,8 @@ sub exit_hook_stop { do { cluck "exit_hook_stop() without exit_hook_start()?"; return; } if \&exit_hook ne \&CORE::GLOBAL::exit; - cluck "INTERNAL: exit_orig uninitialized" if !$exit_orig; + do { cluck "INTERNAL: exit_orig uninitialized"; return; } + if !$exit_orig; # Prevent: Subroutine CORE::GLOBAL::exit redefined no warnings 'redefine'; *CORE::GLOBAL::exit=$exit_orig; @@ -513,10 +521,22 @@ my($msg)=@_; exit; } +sub footer_packages_used_comments() +{ + my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}}; + for my $package (@$packages_used) { + my $cvs_id=(eval('$'.$package."::CVS_ID") +# || $package # debug + ); + Wprint ''."\n" if $cvs_id; + } +} + sub footer() { cluck 'Explicit &footer call is deprecated, !_exit_dne' if !$W->{"_exit_done"}; exit if $W->{"footer_done"}++; # deadlock prevention: + &{$_}() for reverse @{$W->{"footer_sub_push"}}; if ($W->{"header_only"}) { $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1; exit; @@ -555,11 +575,17 @@ sub footer() cluck "Class file $file not found; tried: ".join(" ",@tried) if !$ext; } $file.=$ext; + my $viewcvs; + if ((my $file_cvs=$file)=~s{^My/}{}) { + $viewcvs=$W->{"viewcvs_My"}.$file_cvs; + } + else { + $viewcvs=$W->{"viewcvs"}.$file; + } $cvs_id_split[2]="" - .a_href((map({ my $s=$_; $s=~s#/viewcvs/#$&~checkout~/#; $s; } $W->{"viewcvs"}))[0]."$file?rev=".$cvs_id_split[2], + .a_href((map({ my $s=$_; $s=~s#/viewcvs/#$&~checkout~/#; $s; } $viewcvs))[0]."?rev=".$cvs_id_split[2], $cvs_id_split[2]); - $cvs_id_split[1]=a_href($W->{"viewcvs"}.$file, - ($package!~/^Apache2::/ ? $package : $cvs_id_split[1])); + $cvs_id_split[1]=a_href($viewcvs,($package!~/^Apache2::/ ? $package : $cvs_id_split[1])); $cvs_id_split[5]=&{$W->{"cvs_id_author_sub"}}($cvs_id_split[5]); } join " ",@cvs_id_split; @@ -568,12 +594,7 @@ sub footer() Wprint "

\n"; } - for my $package (@$packages_used) { - my $cvs_id=(eval('$'.$package."::CVS_ID") -# || $package # debug - ); - Wprint ''."\n" if $cvs_id; - } + footer_packages_used_comments(); do { Wprint $_ if $_; } for $W->{"footing"}; @@ -696,6 +717,7 @@ my($self,$url,$status)=@_; $W->{"r"}->headers_out()->{"Location"}=$url; $W->{"header_only"}=1; $W->{"content_type"}=0; + $W->{"charset"}=0; My::Web->heading(); exit; die "NOTREACHED"; @@ -1025,6 +1047,9 @@ sub cache_finish() # as we may have just gave 304 and 'exit;' without starting the caching. return if !$W->{"cache_active"}; + # Headers may not be complete in this case; not sure, just trying. + return if $W->{"r"}->connection()->aborted(); + # Fill-in/check: %uri_args_frozen_to_headers_in_keys my $headers_in_keys_stored_arrayref_ref=\$uri_args_frozen_to_headers_in_keys{$W->{"uri_args_frozen"}}; my @headers_in_keys=tied(%{$W->{"headers_in_RecordKeys"}})->accessed(); @@ -1093,7 +1118,8 @@ my($class)=@_; header("Cache-Control"=>"public"); # HTTP/1.1 # Use $W->{"charset"}=0 to disable charset. - $W->{"charset"}="us-ascii" if !defined $W->{"charset"} && !defined($W->{"content_type"}) || $W->{"content_type"}; + $W->{"charset"}="us-ascii" + if !defined $W->{"charset"} && (!defined($W->{"content_type"}) || $W->{"content_type"}); # Workaround bug # https://bugzilla.mozilla.org/show_bug.cgi?id=120556 @@ -1144,7 +1170,9 @@ my($class)=@_; # FIXME: It is not clean to still append them without overwriting. return if $W->{"heading_done"}; Wprint '{"charset"}.'"?>'."\n" - if (!$W->{"header_only"} || $W->{"header_only"} eq "xml") && $W->{"content_type"}=~m{^application/\w+[+]xml$}; + if (!$W->{"header_only"} || $W->{"header_only"} eq "xml") && (0 + || $W->{"content_type"}=~m{^application/\w+[+]xml$} + || $W->{"content_type"} eq "text/vnd.wap.wml"); return if $W->{"header_only"}; # Split 'heading_done' for the proper handling of: /project/Rel.pm $W->{"heading_done"}++; @@ -1166,8 +1194,10 @@ my($class)=@_; HERE } if ($W->{"css_inherit"}) { + # Do not: HERE } }