Attempted resolving of non-matching headers.
[MyWeb.git] / Web.pm
diff --git a/Web.pm b/Web.pm
index ad685e6..2a9406d 100644 (file)
--- 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: <script />
+               # as at least Lynx inhibits any further HTML output.
                $W->{"head"}.='<script type="text/javascript" src="'.uri_escaped(path_web('/My/HaveJS.pm')).'"></script>'."\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 '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\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 "</p>\n";
                }
 
-       for my $package (@$packages_used) {
-               my $cvs_id=(eval('$'.$package."::CVS_ID")
-#                              || $package     # debug
-                               );
-               Wprint '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\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 '<?xml version="1.0" encoding="'.$W->{"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: <script />
+                       # as at least Lynx inhibits any further HTML output.
                        Wprint <<"HERE";
-<script type="text/javascript" src="@{[ uri_escaped(path_web('/My/css_inherit.js')) ]}" />
+<script type="text/javascript" src="@{[ uri_escaped(path_web('/My/css_inherit.js')) ]}"></script>
 HERE
                        }
                }