Successful port to "SetHandler modperl".

diff --git a/Web.pm b/Web.pm
index d49d900..f940a0c 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -32,6 +32,8 @@ our @ISA=qw(Exporter);
 
 BEGIN
 {
+       $W->{"__My::Web_init"}=1;
+
        sub Wrequire ($)
        {
        my($file)=@_;
@@ -42,7 +44,9 @@ BEGIN
                my $class=$file;
                $file=~s#::#/#g;
                $file.=".pm";
-               my $aref=($W->{"packages_used"}{$Apache::Registry::curstash}||=[]);
+               my $who=$W->{"__PACKAGE__"};
+               $who||="__My::Web" if $W->{"__My::Web_init"};
+               my $aref=($W->{"packages_used"}{$who}||=[]);
                push @$aref,$class
                                if !{ map(($_=>1),@$aref) }->{$class};  # Prevent duplicated entries.
                CORE::require $file;
@@ -70,7 +74,6 @@ use URI::Escape;
 require HTTP::BrowserDetect;
 require HTTP::Negotiate;
 my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; }
-require CGI;
 use ModPerl::Util qw(exit);
 
 
@@ -79,12 +82,12 @@ use ModPerl::Util qw(exit);
                # $W->{"head"}
                # $W->{"head_css"}
                # $W->{"force_charset"}
-               # %{$W->{"packages_used"}
                # $W->{"heading_done"}
                # $W->{"footer_passed"}
                # %{$W->{"headers"}}
                # %{$W->{"headers_lc"}} # maps lc($headers_key)=>$headers_key
-               # @{$W->{"packages_used"}{$Apache::Registry::curstash}}}
+               # @{$W->{"packages_used"}{$W->{"__PACKAGE__"}}}
+               # @{$W->{"packages_used"}{"__My::Web"}}
                # %{$W->{"args"}}
 
 sub init ($%)
@@ -92,13 +95,14 @@ sub init ($%)
 my($class,%args)=@_;
 
        print STDERR "$class->init ".Apache->request()->unparsed_uri()."\n";
-cluck;
 
        my $packages_used_save=$W->{"packages_used"};
        $W={ %WebConfig,%args };        # override %WebConfig settings
        $W->{"packages_used"}=$packages_used_save;
 
-       $W->{"__PACKAGE__"}||="Apache::ROOT".$Apache::Registry::curstash;
+       # {"__PACKAGE__"} is mandatory for mod_perl-2.0;
+       # $Apache::Registry::curstash is no longer supported.
+       do { cluck "No $_" if !$W->{$_}; } for "__PACKAGE__";
 
        $W->{"top_dir"}||=eval '$'.$W->{"__PACKAGE__"}.'::top_dir';
 
@@ -141,7 +145,7 @@ cluck;
        $W->{"r"}->args($W->{"QUERY_STRING"});
        # Do not: $W->{"r"}->args()
        # as it parses only QUERY_STRING (not POST data).
-       $W->{"args"}={ CGI->new()->Vars() };
+       $W->{"args"}={ CGI->new($W->{"r"})->Vars() };
        for (keys(%{$W->{"args"}})) {
                my @vals=split /\x00/,$W->{"args"}{$_};
                next if @vals<=1;
@@ -291,6 +295,14 @@ sub footer (;$)
                Wprint '</form>'."\n";
                }
 
+       my @packages_used=(
+                       $W->{"__PACKAGE__"},
+                       __PACKAGE__,
+                       @{$W->{"packages_used"}{"__My::Web"}},
+                       map((!$_ ? () : @$_),$W->{"packages_used"}{$W->{"__PACKAGE__"}}),
+                       );
+       my %packages_used;
+       @packages_used=grep((!$packages_used{$_}++),@packages_used);
        if ($W->{"footer_ids"}) {
                Wprint '<p class="cvs-id">';
                Wprint join("<br />\n",map({ my $package=$_;
@@ -325,19 +337,11 @@ sub footer (;$)
                                        }
                                join " ",@cvs_id_split;
                                }
-                       } (
-                                       $W->{"__PACKAGE__"},
-                                       __PACKAGE__,
-                                       @{$W->{"packages_used"}{$Apache::Registry::curstash}},
-                                       )));
+                       } @packages_used));
                Wprint "</p>\n";
                }
 
-       for my $package (
-                       $W->{"__PACKAGE__"},
-                       __PACKAGE__,
-                       @{$W->{"packages_used"}{$Apache::Registry::curstash}},
-                       ) {
+       for my $package (@packages_used) {
                my $cvs_id=(eval('$'.$package."::CVS_ID")
 #                              || $package     # debug
                                );
@@ -673,4 +677,8 @@ HERE
                }
 }
 
+BEGIN {
+       delete $W->{"__My::Web_init"};
+       }
+
 1;