Add feature to hide modules that may call require for you when desired.

4 files changed, 66 insertions, 1 deletions

diff --git a/lib/circular/require.pm b/lib/circular/require.pm
index 7bc8552..eeae7ac 100644
--- a/lib/circular/require.pm
+++ b/lib/circular/require.pm
@@ -21,6 +21,12 @@ or
 
   perl -M-circular::require foo.pl
 
+or to hide loaders such as base.pm or parent.pm Any package name(s) can be
+used.
+
+  no circular::require hide => [ qw/base parent/ ];
+
+
 =head1 DESCRIPTION
 
 Perl by default just ignores cycles in require statements - if Foo.pm does
@@ -39,6 +45,7 @@ module has not finished executing.
 
 my %seen;
 my $saved;
+my %settings;
 
 sub _require {
     my ($file) = @_;
@@ -47,7 +54,14 @@ sub _require {
     # string contexts at all
     my $string_file = $file;
     if (exists $seen{$string_file} && !$seen{$string_file}) {
-        warn "Circular require detected: $string_file (from " . caller() . ")\n";
+        my $depth = 0;
+        my $caller;
+
+        $caller = caller( $depth++ )
+            while !$caller
+                || grep { m/^$caller$/ } @{ $settings{hide} };
+
+        warn "Circular require detected: $string_file (from $caller)\n";
     }
     $seen{$string_file} = 0;
     my $ret;
@@ -81,6 +95,9 @@ sub import {
 }
 
 sub unimport {
+    my $class = shift;
+    $class->settings( @_ );
+
     my $stash = Package::Stash->new('CORE::GLOBAL');
     my $old_require = $stash->get_package_symbol('&require');
     $saved = $old_require
@@ -88,6 +105,19 @@ sub unimport {
     $stash->add_package_symbol('&require', \&_require);
 }
 
+sub settings {
+    my $class = shift;
+    my %params = @_;
+
+    %settings = ( %settings, %params );
+
+    $settings{hide} = [ $settings{hide} ]
+        if $settings{hide}
+        && !ref $settings{hide};
+
+    return %settings;
+}
+
 =head1 CAVEATS
 
 This module works by overriding C<CORE::GLOBAL::require>, and so other modules
diff --git a/t/hide_middleman.t b/t/hide_middleman.t
new file mode 100644
index 0000000..d0cf652
--- /dev/null
+++ b/t/hide_middleman.t
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 't/hide_middleman';
+use Test::More;
+use Test::Exception;
+
+my @warnings;
+$SIG{__WARN__} = sub { push @warnings => @_ };
+
+# Test passes if you comment this out
+no circular::require hide => 'base';
+
+use_ok( 'Foo' );
+
+is_deeply(
+    \@warnings,
+    ["Circular require detected: Foo.pm (from Bar)\n"],
+    "Show the module that used base, instead of 'base' when a cycle occurs from a use base."
+);
+
+done_testing;
diff --git a/t/hide_middleman/Bar.pm b/t/hide_middleman/Bar.pm
new file mode 100644
index 0000000..486f8dd
--- /dev/null
+++ b/t/hide_middleman/Bar.pm
@@ -0,0 +1,7 @@
+package Bar;
+use strict;
+use warnings;
+
+use base 'Foo';
+
+1;
diff --git a/t/hide_middleman/Foo.pm b/t/hide_middleman/Foo.pm
new file mode 100644
index 0000000..463f6ec
--- /dev/null
+++ b/t/hide_middleman/Foo.pm
@@ -0,0 +1,6 @@
+package Foo;
+use strict;
+use warnings;
+
+use Bar;
+1;