From 79b443187ee06d8ee7eedc29012e2b68235e3cd1 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 4 Jan 2012 17:52:12 -0600
Subject: use filenames in the "from" part too

this also stops using "caller", which can produce incorrect results if
there are multiple packages in a file, or if you follow it up too far
(saying that the cycle is from 'main' isn't correct)
---
 lib/circular/require.pm | 36 ++++++++++++++++++++++++------------
 t/basic.t               |  6 +++---
 t/hide_middleman.t      |  2 +-
 t/hide_middleman2.t     |  2 +-
 4 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/lib/circular/require.pm b/lib/circular/require.pm
index c05b935..db1738f 100644
--- a/lib/circular/require.pm
+++ b/lib/circular/require.pm
@@ -48,9 +48,10 @@ or
 
 =cut
 
-my %being_loaded;
+our %being_loaded;
 my $saved;
 my @hide;
+our $current;
 
 sub _require {
     my ($file) = @_;
@@ -58,20 +59,19 @@ sub _require {
     # treat it as a vstring, so be sure we don't use the incoming value in
     # string contexts at all
     my $string_file = $file;
-    if ($being_loaded{$string_file}) {
-        my $depth = 0;
-        my $caller;
+    if (exists $being_loaded{$string_file}) {
+        my $caller = $current;
 
-        do {
-            $caller = caller($depth++)
-        } while defined($caller) && grep { m/^$caller$/ } @hide;
+        $caller = $being_loaded{$caller}
+            while defined($caller) && grep { m/^$caller$/ } @hide;
 
         $caller = '<unknown package>'
             unless defined $caller;
 
         warn "Circular require detected: $string_file (from $caller)\n";
     }
-    $being_loaded{$string_file} = 1;
+    local $being_loaded{$string_file} = $current;
+    local $current = $string_file;
     my $ret;
     # XXX ugh, base.pm checks against the regex
     # /^Can't locate .*? at \(eval / to see if it should suppress the error
@@ -79,9 +79,7 @@ sub _require {
     # definitely break if some other module that overrides CORE::require tries
     # to do the same thing
     if (caller eq 'base') {
-        my $mod = $file;
-        $mod =~ s+[/\\]+::+g;
-        $mod =~ s+\.pm$++;
+        my $mod = _pm2mod($file);
         $ret = $saved
             ? $saved->($file)
             : (eval "CORE::require $mod" || die $@);
@@ -89,7 +87,6 @@ sub _require {
     else {
         $ret = $saved ? $saved->($file) : CORE::require($file);
     }
-    delete $being_loaded{$string_file};
     return $ret;
 }
 
@@ -109,6 +106,7 @@ sub unimport {
 
     @hide = ref($params{'-hide'}) ? @{ $params{'-hide'} } : ($params{'-hide'})
         if exists $params{'-hide'};
+    @hide = map { /\.pm/ ? $_ : _mod2pm($_) } @hide;
 
     my $stash = Package::Stash->new('CORE::GLOBAL');
     my $old_require = $stash->get_package_symbol('&require');
@@ -117,6 +115,20 @@ sub unimport {
     $stash->add_package_symbol('&require', \&_require);
 }
 
+sub _mod2pm {
+    my ($mod) = @_;
+    $mod =~ s+::+/+g;
+    $mod .= '.pm';
+    return $mod;
+}
+
+sub _pm2mod {
+    my ($file) = @_;
+    $file =~ s+/+::+g;
+    $file =~ s+\.pm$++;
+    return $file;
+}
+
 =head1 CAVEATS
 
 This module works by overriding C<CORE::GLOBAL::require>, and so other modules
diff --git a/t/basic.t b/t/basic.t
index 62d92f5..ea59925 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -12,7 +12,7 @@ circular::require->unimport;
     my $warnings;
     local $SIG{__WARN__} = sub { $warnings .= $_[0] };
     use_ok('Foo');
-    is($warnings, "Circular require detected: Foo.pm (from Baz)\nCircular require detected: Baz.pm (from Bar)\n", "correct warnings");
+    is($warnings, "Circular require detected: Foo.pm (from Baz.pm)\nCircular require detected: Baz.pm (from Bar.pm)\n", "correct warnings");
     clear();
 }
 
@@ -20,7 +20,7 @@ circular::require->unimport;
     my $warnings;
     local $SIG{__WARN__} = sub { $warnings .= $_[0] };
     use_ok('Bar');
-    is($warnings, "Circular require detected: Baz.pm (from Foo)\nCircular require detected: Bar.pm (from Baz)\n", "correct warnings");
+    is($warnings, "Circular require detected: Baz.pm (from Foo.pm)\nCircular require detected: Bar.pm (from Baz.pm)\n", "correct warnings");
     clear();
 }
 
@@ -28,7 +28,7 @@ circular::require->unimport;
     my $warnings;
     local $SIG{__WARN__} = sub { $warnings .= $_[0] };
     use_ok('Baz');
-    is($warnings, "Circular require detected: Baz.pm (from Foo)\n", "correct warnings");
+    is($warnings, "Circular require detected: Baz.pm (from Foo.pm)\nCircular require detected: Baz.pm (from Bar.pm)\n", "correct warnings");
     clear();
 }
 
diff --git a/t/hide_middleman.t b/t/hide_middleman.t
index 72fa9c6..90950b2 100644
--- a/t/hide_middleman.t
+++ b/t/hide_middleman.t
@@ -16,7 +16,7 @@ my @warnings;
 
 is_deeply(
     \@warnings,
-    ["Circular require detected: Foo.pm (from Bar)\n"],
+    ["Circular require detected: Foo.pm (from Bar.pm)\n"],
     "Show the module that used base, instead of 'base' when a cycle occurs from a use base."
 );
 
diff --git a/t/hide_middleman2.t b/t/hide_middleman2.t
index 917674b..bb3092a 100644
--- a/t/hide_middleman2.t
+++ b/t/hide_middleman2.t
@@ -16,7 +16,7 @@ my @warnings;
 
 is_deeply(
     \@warnings,
-    ["Circular require detected: Foo.pm (from Bar)\n"],
+    ["Circular require detected: Foo.pm (from Bar.pm)\n"],
     "Show the module that used base, instead of 'base' when a cycle occurs from a use base."
 );
 
-- 
cgit v1.2.3-54-g00ecf