Porting to "SetHandler modperl"...

diff --git a/Web.pm b/Web.pm
index 2c720f3..d49d900 100644 (file)
--- 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"});