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,
};
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";
}
}
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';
{
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;
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;
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;
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"};
$W->{"r"}->headers_out()->{"Location"}=$url;
$W->{"header_only"}=1;
$W->{"content_type"}=0;
+ $W->{"charset"}=0;
My::Web->heading();
exit;
die "NOTREACHED";
# 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();
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
# of at least
# Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
# http://validator.w3.org/ does not send ANY "Accept" headers!
- $W->{"content_type"}="application/xhtml+xml" if !defined $W->{"content_type"}
- && !$W->{"headers_in"}{"Accept"}
- && ($W->{"headers_in"}{"User-Agent"}||"")=~m{^W3C_Validator/}i;
- defined($W->{"content_type"}) or $W->{"content_type"}=$class->Negotiate_choose([
- # Put the fallback variant as the first one.
- # Rate both variants the same to prefer "text/html" for undecided clients.
- # At least
- # Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
- # prefers "application/xhtml+xml" over "text/html" itself:
- # text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
- negotiate_variant(
- "id"=>"text/html",
- "content-type"=>"text/html",
- "qs"=>0.6,
- (!$W->{"charset"} ? () : "charset"=>$W->{"charset"}),
- "lang"=>$W->{"language"},
- ),
- negotiate_variant(
- "id"=>"application/xhtml+xml",
- "content-type"=>"application/xhtml+xml",
- "qs"=>0.6,
- (!$W->{"charset"} ? () : "charset"=>$W->{"charset"}),
- "lang"=>$W->{"language"},
- ),
- # application/xml ?
- # text/xml ?
- ]);
+ if (!defined $W->{"content_type"}) {
+ # Be _stable_ for "headers_in".
+ my $accept=$W->{"headers_in"}{"Accept"};
+ my $user_agent=$W->{"headers_in"}{"User-Agent"}||"";
+ $W->{"content_type"}="application/xhtml+xml"
+ if !$accept && $user_agent=~m{^W3C_Validator/}i;
+ # Be _stable_:
+ my $negotiated=$class->Negotiate_choose([
+ # Put the fallback variant as the first one.
+ # Rate both variants the same to prefer "text/html" for undecided clients.
+ # At least
+ # Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
+ # prefers "application/xhtml+xml" over "text/html" itself:
+ # text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
+ negotiate_variant(
+ "id"=>"text/html",
+ "content-type"=>"text/html",
+ "qs"=>0.6,
+ (!$W->{"charset"} ? () : "charset"=>$W->{"charset"}),
+ "lang"=>$W->{"language"},
+ ),
+ negotiate_variant(
+ "id"=>"application/xhtml+xml",
+ "content-type"=>"application/xhtml+xml",
+ "qs"=>0.6,
+ (!$W->{"charset"} ? () : "charset"=>$W->{"charset"}),
+ "lang"=>$W->{"language"},
+ ),
+ # application/xml ?
+ # text/xml ?
+ ]);
+ $W->{"content_type"}=$negotiated if !defined $W->{"content_type"};
+ }
# mod_perl doc: If you set this header via the headers_out table directly, it
# will be ignored by Apache. So do not do that.
my $type;
# 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"}++;
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
}
}