Fixed package callers tracking.

diff --git a/Web.pm b/Web.pm
index 3fdfdad..8b1859c 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -54,12 +54,18 @@ BEGIN
                my $class=$file;
                $file=~s#::#/#g;
                $file.=".pm";
-               my $who=$W->{"__PACKAGE__"};
-               $who||="__My::Web" if $W->{"__My::Web_init"};
-               if ($who) {
-                       my $aref=($W->{"packages_used"}{$who}||=[]);
-                       push @$aref,$class
-                                       if !{ map(($_=>1),@$aref) }->{$class};  # Prevent duplicated entries.
+               my %callers;
+               for (my $depth=0;defined caller($depth);$depth++) {
+                       $callers{caller($depth)}=1;
+                       }
+               my $selfpkg=__PACKAGE__;
+               $callers{$selfpkg}=1;
+               for my $target ($class,__PACKAGE__) {
+                       for my $caller (keys(%callers)) {
+                               next if $caller eq $target;
+                               next if $W->{'packages_used%'}{$caller}{$target}++;
+                               push @{$W->{'packages_used@'}{$caller}},$target;
+                               }
                        }
                eval { CORE::require "$file"; } or confess $@;
                1;      # Otherwise 'require' would already file above.
@@ -75,10 +81,18 @@ BEGIN
                $file->import(@list);
                1;
        }
+
+       sub import
+       {
+       my($class,@rest)=@_;
+
+               local $Exporter::ExportLevel=$Exporter::ExportLevel+1;
+               Wrequire("$class");
+               return $class->SUPER::import(@rest);
+       }
 }
 
-BEGIN { Wuse 'WebConfig'; }    # for %WebConfig
-BEGIN { Wuse 'My::Hash::Sub'; }
+use WebConfig; # see also below: Wuse 'WebConfig';
 require CGI;   # for &escapeHTML
 require Image::Size;   # for &imgsize
 use File::Basename;    # &basename
@@ -106,8 +120,8 @@ use Cwd;
                # $W->{"footer_passed"}
                # %{$W->{"headers"}}
                # %{$W->{"headers_lc"}} # maps lc($headers_key)=>$headers_key
-               # @{$W->{"packages_used"}{$W->{"__PACKAGE__"}}}
-               # @{$W->{"packages_used"}{"__My::Web"}}
+               # @{$W->{'packages_used@'}{callers...}}
+               # %{$W->{'packages_used%'}{callers...}}
                # %{$W->{"args"}}
 
 sub init ($%)
@@ -116,11 +130,19 @@ my($class,%args)=@_;
 
        print STDERR "$class->init ".Apache2::RequestUtil->request()->unparsed_uri()."\n";
 
-       my $packages_used_save=$W->{"packages_used"};
+       # We need to track package dependencies, so we need to call it from &init.
+       # We cannot do it in BEGIN { } block
+       # as it would not be tracked for each of the toplevel users later.
+       Wuse 'WebConfig';
+       Wrequire 'My::Hash::Sub';
+
+       my $packages_used_array_save=$W->{'packages_used@'};
+       my $packages_used_hash_save =$W->{'packages_used%'};
        $W={};
        tie %$W,"My::Hash::Sub";
        %$W=(%WebConfig,%args); # override %WebConfig settings
-       $W->{"packages_used"}=$packages_used_save;
+       $W->{'packages_used@'}=$packages_used_array_save;
+       $W->{'packages_used%'}=$packages_used_hash_save;
        $W->{"__PACKAGE__"}||=caller();
 
        # {"__PACKAGE__"} is mandatory for mod_perl-2.0;
@@ -389,14 +411,8 @@ sub footer (;$)
 
        Wprint "<hr />\n" if $W->{"footer"};
 
-       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);
+       my $packages_used=$W->{'packages_used@'}{$W->{"__PACKAGE__"}};
+
        if ($W->{"footer_ids"}) {
                Wprint '<p class="cvs-id">';
                Wprint join("<br />\n",map({ my $package=$_;
@@ -431,11 +447,11 @@ sub footer (;$)
                                        }
                                join " ",@cvs_id_split;
                                }
-                       } @packages_used));
+                       } @$packages_used));
                Wprint "</p>\n";
                }
 
-       for my $package (@packages_used) {
+       for my $package (@$packages_used) {
                my $cvs_id=(eval('$'.$package."::CVS_ID")
 #                              || $package     # debug
                                );