From: short <>
Date: Wed, 21 Sep 2005 04:55:54 +0000 (+0000)
Subject: &My::Web::footer call is deprecated now, use just: exit;
X-Git-Url: https://git.jankratochvil.net/?p=MyWeb.git;a=commitdiff_plain;h=fe50af8cc39d37a8277765379f0a12ea5a684399

&My::Web::footer call is deprecated now, use just: exit;
---

diff --git a/Web.pm b/Web.pm
index de12860..3661bd4 100644
--- a/Web.pm
+++ b/Web.pm
@@ -68,6 +68,8 @@ BEGIN
 			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;
 				}
 			}
@@ -123,32 +125,11 @@ require Encode;
 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)=@_;
@@ -283,6 +264,33 @@ 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.
@@ -301,6 +309,17 @@ my($text,%args)=@_;
 	$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)=@_;
@@ -466,21 +485,22 @@ my($msg)=@_;
 	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:
 
 	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=$_;
@@ -529,7 +549,7 @@ sub footer (;$)
 	do { Wprint $_ if $_; } for $W->{"footing"};
 
 	Wprint "</body></html>\n";
-	exit 0;
+	exit;
 }
 
 # Existing entries are overwritten.
@@ -938,7 +958,7 @@ sub cache_start()
 			}
 		last if OK==$status;
 		$W->{"r"}->status($status);
-		exit 0;
+		exit;
 		die "NOTREACHED";
 		}
 
@@ -971,7 +991,7 @@ sub cache_finish_last_modified()
 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
@@ -1100,7 +1120,7 @@ my($class)=@_;
 	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