for my $caller (keys(%callers)) {
next if $caller eq $target;
next if $packages_used_hash{$caller}{$target}++;
+ cluck "Appending to the '_done' package list: caller=$caller,target=$target"
+ if $packages_used_hash{$caller}{"_done"};
push @{$packages_used_array{$caller}},$target;
}
}
use Apache2::Filter;
use Apache2::Connection;
require MIME::Base64;
+use Apache2::ServerUtil;
#our $W;
-sub cleanup($)
-{
-my($apache_request)=@_;
-
- $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
- cache_finish();
- # Sanity protection.
- $W=undef();
- return OK;
-}
-
-sub request_check(;$)
-{
-my($self)=@_;
-
- # Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
- # CGI requires valid "r": check it beforehand here.
- confess "Calling sensitive dynamic code from a static code" if !eval { Apache2::RequestUtil->request(); };
- # Do not: confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
- # as it is valid at least while preparing arguments to call: &project::Lib::init
-}
-
sub init ($%)
{
my($class,%args)=@_;
return bless $W,$class;
}
+sub cleanup($)
+{
+my($apache_request)=@_;
+
+ cluck "CORE::GLOBAL::exit hook not ran" if !$W->{"_exit_ran"};
+ cluck "packages not finalized" if !$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"};
+ cache_finish();
+ # Sanity protection.
+ $W=undef();
+ return OK;
+}
+
+# PerlResponseHandler is RUN_FIRST and &ModPerl::Util::exit returns OK, so no (sane) go.
+# PerlLogHandler is already too late to be able to produce any output.
+my $exit_orig=\&CORE::GLOBAL::exit;
+sub exit_hook
+{
+ # &footer will call us recursively!
+ footer() if !$W->{"_exit_ran"}++;
+ return &{$exit_orig}(@_);
+}
+{
+ # Prevent: Subroutine CORE::GLOBAL::exit redefined
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit=\&exit_hook;
+ }
+
# Be aware other parts of code (non-My::Web) will NOT use this function!
# Do not: Wprint $W->{"heading"},"undef"=>1;
# as we would need to undef() it to turn it off and it would get defaulted in such case.
$W->{"r"}->puts($text);
}
+sub request_check(;$)
+{
+my($self)=@_;
+
+ # Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
+ # CGI requires valid "r": check it beforehand here.
+ confess "Calling sensitive dynamic code from a static code" if !eval { Apache2::RequestUtil->request(); };
+ # Do not: confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
+ # as it is valid at least while preparing arguments to call: &project::Lib::init
+}
+
sub escapeHTML($)
{
my($text)=@_;
Wprint "\n".vskip("3ex")."<hr /><h1 class=\"error\">FATAL ERROR: $msg!</h1>\n"
."<p>You can report this problem's details to"
." ".a_href("mailto:".$W->{"admin_mail"},"admin of this website").".</p>\n";
- footer();
+ exit;
}
-sub footer (;$)
+sub footer()
{
- exit 1 if $W->{"footer_passed"}++; # deadlock prevention:
+ cluck 'Explicit &footer call is deprecated' if !$W->{"_exit_ran"};
+ exit if $W->{"footer_passed"}++; # deadlock prevention:
+ if ($W->{"header_only"}) {
+ $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
+ exit;
+ }
Wprint vskip if $W->{"footer_delimit"};
-
- do { Wprint $_ if $_; } for $W->{"footing_delimit"};
-
+ &{$_}() for reverse @{$W->{"footing_delimit_sub_push"}};
Wprint "<hr />\n" if $W->{"footer"};
- my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
+ # Never update the package list while we examine it!
+ $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
+ my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
if ($W->{"footer_ids"}) {
Wprint '<p class="cvs-id">';
Wprint join("<br />\n",map({ my $package=$_;
do { Wprint $_ if $_; } for $W->{"footing"};
Wprint "</body></html>\n";
- exit 0;
+ exit;
}
# Existing entries are overwritten.
}
last if OK==$status;
$W->{"r"}->status($status);
- exit 0;
+ $W->{"header_only"}=1; # Inhibit &footer output.
+ exit;
die "NOTREACHED";
}
sub cache_finish()
{
# Do not: return if !$W->{"uri_args_frozen"};
- # as we may have just gave 304 and 'exit 0;' without starting the caching.
+ # as we may have just gave 304 and 'exit;' without starting the caching.
return if !$W->{"cache_active"};
# Fill-in/check: %uri_args_frozen_to_headers_in_keys
my %headers_out;
# Do not: $W->{"digest-md5"}->b64digest();
# as it will not provide the trailing filling '='s.
- # RFC 1864 is not clear but the same provides them.
- # FIXME: Should we somehow provide "\r\n" newlines for the text data? Which content is "text"?
- # Maybe it does not apply to HTTP as RFC 1864 targets mail/MIME.
+ # RFC 1864 is not clear if they should be there but its sample provides them.
+ # Do not try to provide canonical "\r\n" form of newlines as is said by RFC 1864.
+ # RFC 2068 (HTTP/1.1) section 14.16 says the newlines should NOT be converted for HTTP.
# ',""' to avoid breaking the headers by its default "\n".
$headers_out{"Content-MD5"}=MIME::Base64::encode_base64($W->{"digest-md5"}->digest(),"");
# In fact we could also use MD5 for ETag as if we know ETag we also know MD5.
Wprint "<title>$title</title>\n";
if ($W->{"have_css"}) {
# Everything can get overriden later.
- for my $css ("/My/Web.css",map((!$_ ? () : ("ARRAY" ne ref($_) ? $_ : @$_)),$W->{"css_push"})) {
+ for my $css ("/My/Web.css",@{$W->{"css_push"}}) {
Wprint <<"HERE";
<link rel="stylesheet" type="text/css" href="@{[ uri_escaped(path_web $css) ]}" />
HERE