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 ++++++++++++++++++++++++------------
 1 file changed, 24 insertions(+), 12 deletions(-)

(limited to 'lib')

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
-- 
cgit v1.2.3-54-g00ecf