From deedaef8ae8995e6d3bfe92f0ee0035e1186b84c Mon Sep 17 00:00:00 2001
From: short <>
Date: Tue, 19 Oct 2004 16:43:25 +0000
Subject: [PATCH] Porting to "SetHandler modperl"...

---
 Web.pm | 95 +++++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 50 insertions(+), 45 deletions(-)

diff --git a/Web.pm b/Web.pm
index 2c720f3..d49d900 100644
--- a/Web.pm
+++ b/Web.pm
@@ -27,7 +27,7 @@ use Exporter;
 sub Wrequire ($);
 sub Wuse ($@);
 our $W;
-our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img &centerimg &rightimg $W &top_dir &top_dir_disk);
+our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img &centerimg &rightimg $W &top_dir &top_dir_disk &Wprint);
 our @ISA=qw(Exporter);
 
 BEGIN
@@ -71,12 +71,7 @@ require HTTP::BrowserDetect;
 require HTTP::Negotiate;
 my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; }
 require CGI;
-require Apache2;
-
-
-# Undo 'www/engine/httpd-restart' as it may use obsolete Perl for 'mod_perl'
-delete $ENV{"PERLLIB"};
-delete $ENV{"LD_LIBRARY_PATH"};
+use ModPerl::Util qw(exit);
 
 
 #our $W;
@@ -96,7 +91,8 @@ sub init ($%)
 {
 my($class,%args)=@_;
 
-	print STDERR "$class->init ".$ENV{"REQUEST_URI"}."\n";
+	print STDERR "$class->init ".Apache->request()->unparsed_uri()."\n";
+cluck;
 
 	my $packages_used_save=$W->{"packages_used"};
 	$W={ %WebConfig,%args };	# override %WebConfig settings
@@ -143,7 +139,6 @@ my($class,%args)=@_;
 		}
 	$W->{"QUERY_STRING"}=~s/([&])amp;/$1/g;
 	$W->{"r"}->args($W->{"QUERY_STRING"});
-	$ENV{"QUERY_STRING"}=$W->{"QUERY_STRING"};
 	# Do not: $W->{"r"}->args()
 	# as it parses only QUERY_STRING (not POST data).
 	$W->{"args"}={ CGI->new()->Vars() };
@@ -153,8 +148,8 @@ my($class,%args)=@_;
 		$W->{"args"}{$_}=[@vals];
 		}
 
-	do { $W->{$_}=$ENV{"HTTP_ACCEPT"} if !defined $W->{$_}; } for ("accept");
-	do { $W->{$_}=$ENV{"HTTP_USER_AGENT"} if !defined $W->{$_}; } for ("user_agent");
+	do { $W->{$_}=$W->{"r"}->headers_in()->{"Accept"}     if !defined $W->{$_}; } for ("accept");
+	do { $W->{$_}=$W->{"r"}->headers_in()->{"User-Agent"} if !defined $W->{$_}; } for ("user_agent");
 
 	$W->{"browser"}=HTTP::BrowserDetect->new($W->{"user_agent"});
 
@@ -172,6 +167,13 @@ my($class,%args)=@_;
 	return $W;
 }
 
+sub Wprint($)
+{
+my($text)=@_;
+
+	$W->{"r"}->print($text);
+}
+
 sub top_dir_disk ()
 {
 	do { return $_ if $_; } for ($W->{"top_dir"});
@@ -182,7 +184,7 @@ sub top_dir (;$)
 {
 my($in)=@_;
 
-	if (my $uri=$ENV{"REQUEST_URI"}) {
+	if (my $uri=$W->{"r"}->unparsed_uri()) {
 		if ($W->{"args"}{"Wabs"}) {
 			# FIXME: $in may not be defined here!
 			# to prevent: Use of uninitialized value in ...
@@ -190,7 +192,7 @@ my($in)=@_;
 				$in=~s#^/*##;
 				}
 			else {
-				$in=$ENV{"REQUEST_URI"}."/".$in;
+				$in=$uri."/".$in;
 				$in=~tr#/#/#s;
 				1 while $in=~s#/(?:[^/]+)/\Q..\E/#/#g
 				}
@@ -257,7 +259,7 @@ my($msg)=@_;
 
 	$W->{"indexme"}=0;	# For the case no heading was sent yet.
 	My::Web->heading();
-	print "\n".vskip("3ex")."<hr /><h1 class=\"error\">FATAL ERROR: $msg!</h1>\n"
+	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();
@@ -267,31 +269,31 @@ sub footer (;$)
 {
 	exit 1 if $W->{"footer_passed"}++;	# deadlock prevention:
 
-	print vskip if $W->{"footer_delimit"};
+	Wprint vskip if $W->{"footer_delimit"};
 
 	if ($W->{"heading"}) {
 		do { &{$_}() if $_; } for ($W->{"footing_delimit"});
 		}
 
-	print "<hr />\n" if $W->{"footer"};
+	Wprint "<hr />\n" if $W->{"footer"};
 
 	if ($W->{"footer_mailme"}) {
-		print '<form action="'.top_dir('/SendMsg.pl').'" method="post" onsubmit="'
+		Wprint '<form action="'.top_dir('/SendMsg.pl').'" method="post" onsubmit="'
 				."this.elements['msgscript'].value=this.elements['msghtml'].value;"
 				."this.elements['msghtml'].value='';"
 				."this.submit();"
 				.'">'."\n";
-			print '<p align="right">'."\n";
-				print '<input name="msgscript" type="hidden" />'."\n";
-				print '<input name="msghtml" type="text" size="32" alt="Message" />'."\n";
-				print '<input name="submit" type="submit" value="Quick Note" />'."\n";
-			print '</p>'."\n";
-		print '</form>'."\n";
+			Wprint '<p align="right">'."\n";
+				Wprint '<input name="msgscript" type="hidden" />'."\n";
+				Wprint '<input name="msghtml" type="text" size="32" alt="Message" />'."\n";
+				Wprint '<input name="submit" type="submit" value="Quick Note" />'."\n";
+			Wprint '</p>'."\n";
+		Wprint '</form>'."\n";
 		}
 
 	if ($W->{"footer_ids"}) {
-		print '<p class="cvs-id">';
-		print join("<br />\n",map({ my $package=$_;
+		Wprint '<p class="cvs-id">';
+		Wprint join("<br />\n",map({ my $package=$_;
 			my $cvs_id=(eval('$'.$package."::CVS_ID")
 #					|| $package	# debug
 					);
@@ -305,10 +307,13 @@ sub footer (;$)
 					my $file=$package;
 					$file=~s#::#/#g;
 					my $ext;
+					my @tried;
 					for (qw(.html.pl .pl .pm),"") {
 						$ext=$_;
-						last if -r top_dir_disk()."/$file$ext";
-						cluck "Class file $file not found" if !$ext;
+						my $pathname=top_dir_disk()."/$file$ext";
+						push @tried,$pathname;
+						last if -r $pathname;
+						cluck "Class file $file not found; tried: ".join(" ",@tried) if !$ext;
 						}
 					$file.=$ext;
 					$cvs_id_split[2]=""
@@ -325,7 +330,7 @@ sub footer (;$)
 					__PACKAGE__,
 					@{$W->{"packages_used"}{$Apache::Registry::curstash}},
 					)));
-		print "</p>\n";
+		Wprint "</p>\n";
 		}
 
 	for my $package (
@@ -336,14 +341,14 @@ sub footer (;$)
 		my $cvs_id=(eval('$'.$package."::CVS_ID")
 #				|| $package	# debug
 				);
-		print '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\n" if $cvs_id;
+		Wprint '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\n" if $cvs_id;
 		}
 
 	if ($W->{"heading"}) {
 		do { &{$_}() if $_; } for ($W->{"footing"});
 		}
 
-	print "</body></html>\n";
+	Wprint "</body></html>\n";
 	exit(0);
 }
 
@@ -430,7 +435,7 @@ sub remote_ip ()
 	# As 'Apache::ForwardedFor' takes the first of $ENV{"HTTP_X_FORWARDED_FOR"}
 	# while the contents is '127.0.0.1, 213.220.195.171' if client has its own proxy.
 	# We must take the last item ourselves.
-	my $r=$ENV{"HTTP_X_FORWARDED_FOR"} || $W->{"r"}->get_remote_host();
+	my $r=$W->{"r"}->headers_in()->{"X-Forwarded-For"} || $W->{"r"}->get_remote_host();
 	$r=~s/^.*,\s*//;
 	return $r;
 }
@@ -616,17 +621,17 @@ my($class)=@_;
 	exit if $W->{"r"}->header_only();
 
 	if (1) { # || !$msie_major || $msie_major>=4) # TODO:dyn
-		print '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n";
+		Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n";
 		}
-	print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
-	print '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US">'."\n";
+	Wprint '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
+	Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US">'."\n";
 	my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
 	$title=~s#<[^>]*>##g;
-	print "<head>";
-	print "<title>$title</title>\n";
+	Wprint "<head>";
+	Wprint "<title>$title</title>\n";
 
 	if ($W->{"have_css"}) {
-		print <<'HERE';
+		Wprint <<'HERE';
 <style type="text/css"><!--
 .cvs-id   { font-family: monospace; }
 .error    { color: red;   background-color: transparent; }
@@ -649,19 +654,19 @@ td       { padding: 2px; }
 caption  { caption-side: bottom; }
 .footer img { vertical-align: middle; }
 HERE
-		print $W->{"head_css"}."\n";
-		print "--></style>\n";
+		Wprint $W->{"head_css"}."\n";
+		Wprint "--></style>\n";
 		}
 
-	print '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
-	print $W->{"head"};
+	Wprint '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
+	Wprint $W->{"head"};
 	for my $type (qw(prev next index contents start up)) {
-		do { print '<link rel="'.$type.'" href="'.$_.'" />'."\n" if $_; } for ($W->{"rel_$type"});
+		do { Wprint '<link rel="'.$type.'" href="'.$_.'" />'."\n" if $_; } for ($W->{"rel_$type"});
 		}
-	print "</head><body";
-#	print ' bgcolor="black" text="white" link="aqua" vlink="teal"'
+	Wprint "</head><body";
+#	Wprint ' bgcolor="black" text="white" link="aqua" vlink="teal"'
 #			if $W->{"browser"}->netscape() && (!$W->{"browser"}->major() || $W->{"browser"}->major()<=4);
-	print ">\n";
+	Wprint ">\n";
 
 	if ($W->{"heading"}) {
 		do { &{$_}() if $_; } for ($W->{"heading"});
-- 
1.8.3.1