From 1034da1ff657419f79977ab52bb2e9e0f7b3a413 Mon Sep 17 00:00:00 2001 From: Chad 'Exodist' Granum Date: Tue, 20 Dec 2011 15:43:57 -0800 Subject: Add feature to hide modules that may call require for you when desired. --- lib/circular/require.pm | 32 +++++++++++++++++++++++++++++++- t/hide_middleman.t | 22 ++++++++++++++++++++++ t/hide_middleman/Bar.pm | 7 +++++++ t/hide_middleman/Foo.pm | 6 ++++++ 4 files changed, 66 insertions(+), 1 deletion(-) create mode 100644 t/hide_middleman.t create mode 100644 t/hide_middleman/Bar.pm create mode 100644 t/hide_middleman/Foo.pm 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, 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; -- cgit v1.2.3-54-g00ecf