From c79c6b5bfd4da403dc38e064c7ae50d9a0b67309 Mon Sep 17 00:00:00 2001
From: short <>
Date: Sun, 21 Aug 2005 19:13:01 +0000
Subject: [PATCH] Fixed package callers tracking.

---
 Web.pm | 60 ++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 38 insertions(+), 22 deletions(-)

diff --git a/Web.pm b/Web.pm
index 3fdfdad..8b1859c 100644
--- 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
 				);
-- 
1.8.3.1