diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Module-Pluggable/lib')
3 files changed, 206 insertions, 71 deletions
diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm index 69f8dcaa447..cf285693e2f 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm @@ -4,6 +4,8 @@ use strict; use base qw(Exporter); use vars qw($VERSION @EXPORT_OK); +use if $] > 5.017, 'deprecate'; + $VERSION = '0.4'; @EXPORT_OK = qw(list_packages); @@ -11,7 +13,6 @@ $VERSION = '0.4'; =head1 NAME - Devel::InnerPackage - find all the inner packages of a package =head1 SYNOPSIS diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm index 55cf7269e70..9e7962efab7 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm @@ -1,15 +1,18 @@ package Module::Pluggable; use strict; -use vars qw($VERSION); +use vars qw($VERSION $FORCE_SEARCH_ALL_PATHS); use Module::Pluggable::Object; +use if $] > 5.017, 'deprecate'; + # ObQuote: # Bob Porter: Looks like you've been missing a lot of work lately. # Peter Gibbons: I wouldn't say I've been missing it, Bob! -$VERSION = '4.0'; +$VERSION = '4.7'; +$FORCE_SEARCH_ALL_PATHS = 0; sub import { my $class = shift; @@ -22,6 +25,7 @@ sub import { my ($package) = $opts{'package'} || $pkg; $opts{filename} = $file; $opts{package} = $package; + $opts{force_search_all_paths} = $FORCE_SEARCH_ALL_PATHS unless exists $opts{force_search_all_paths}; my $finder = Module::Pluggable::Object->new(%opts); @@ -152,9 +156,8 @@ Optionally it instantiates those classes for you. =head1 ADVANCED USAGE - Alternatively, if you don't want to use 'plugins' as the method ... - + package MyClass; use Module::Pluggable sub_name => 'foo'; @@ -227,6 +230,21 @@ and then later ... my @filters = $self->filters; my @plugins = $self->plugins; + +=head1 PLUGIN SEARCHING + +Every time you call 'plugins' the whole search path is walked again. This allows +for dynamically loading plugins even at run time. However this can get expensive +and so if you don't expect to want to add new plugins at run time you could do + + + package Foo; + use strict; + use Module::Pluggable sub_name => '_plugins'; + + our @PLUGINS; + sub plugins { @PLUGINS ||= shift->_plugins } + 1; =head1 INNER PACKAGES @@ -307,6 +325,62 @@ the extensions F<.swp> or F<.swo>, or files beginning with F<.#>. Setting C<include_editor_junk> changes C<Module::Pluggable> so it does not ignore any files it finds. +=head2 follow_symlinks + +Whether, when searching directories, to follow symlinks. + +Defaults to 1 i.e do follow symlinks. + +=head2 min_depth, max_depth + +This will allow you to set what 'depth' of plugin will be allowed. + +So, for example, C<MyClass::Plugin::Foo> will have a depth of 3 and +C<MyClass::Plugin::Foo::Bar> will have a depth of 4 so to only get the former +(i.e C<MyClass::Plugin::Foo>) do + + package MyClass; + use Module::Pluggable max_depth => 3; + +and to only get the latter (i.e C<MyClass::Plugin::Foo::Bar>) + + package MyClass; + use Module::Pluggable min_depth => 4; + + +=head1 TRIGGERS + +Various triggers can also be passed in to the options. + +If any of these triggers return 0 then the plugin will not be returned. + +=head2 before_require <plugin> + +Gets passed the plugin name. + +If 0 is returned then this plugin will not be required either. + +=head2 on_require_error <plugin> <err> + +Gets called when there's an error on requiring the plugin. + +Gets passed the plugin name and the error. + +The default on_require_error handler is to C<carp> the error and return 0. + +=head2 on_instantiate_error <plugin> <err> + +Gets called when there's an error on instantiating the plugin. + +Gets passed the plugin name and the error. + +The default on_instantiate_error handler is to C<carp> the error and return 0. + +=head2 after_require <plugin> + +Gets passed the plugin name. + +If 0 is returned then this plugin will be required but not returned as a plugin. =head1 METHODs @@ -319,7 +393,29 @@ search_path. $self->search_path( add => "New::Path" ); # add $self->search_path( new => "New::Path" ); # replace +=head1 BEHAVIOUR UNDER TEST ENVIRONMENT +In order to make testing reliable we exclude anything not from blib if blib.pm is +in %INC. + +However if the module being tested used another module that itself used C<Module::Pluggable> +then the second module would fail. This was fixed by checking to see if the caller +had (^|/)blib/ in their filename. + +There's an argument that this is the wrong behaviour and that modules should explicitly +trigger this behaviour but that particular code has been around for 7 years now and I'm +reluctant to change the default behaviour. + +You can now (as of version 4.1) force Module::Pluggable to look outside blib in a test environment by doing either + + require Module::Pluggable; + $Module::Pluggable::FORCE_SEARCH_ALL_PATHS = 1; + import Module::Pluggable; + +or + + use Module::Pluggable force_search_all_paths => 1; + =head1 FUTURE PLANS @@ -332,6 +428,12 @@ Recently tried fixed to find inner packages and to make it However suggestions (and patches) are welcome. +=head1 DEVELOPMENT + +The master repo for this module is at + +https://github.com/simonwistow/Module-Pluggable + =head1 AUTHOR Simon Wistow <simon@thegestalt.org> diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm index e0ee993075d..6b1d265456c 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm @@ -4,11 +4,13 @@ use strict; use File::Find (); use File::Basename; use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel); -use Carp qw(croak carp); +use Carp qw(croak carp confess); use Devel::InnerPackage; use vars qw($VERSION); -$VERSION = '3.9'; +use if $] > 5.017, 'deprecate'; + +$VERSION = '4.6'; sub new { @@ -25,64 +27,74 @@ sub new { sub plugins { - my $self = shift; - - # override 'require' - $self->{'require'} = 1 if $self->{'inner'}; - - my $filename = $self->{'filename'}; - my $pkg = $self->{'package'}; - - # Get the exception params instantiated - $self->_setup_exceptions; - - # automatically turn a scalar search path or namespace into a arrayref - for (qw(search_path search_dirs)) { - $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); - } - - # default search path is '<Module>::<Name>::Plugin' - $self->{'search_path'} = ["${pkg}::Plugin"] unless $self->{'search_path'}; + my $self = shift; + my @args = @_; + # override 'require' + $self->{'require'} = 1 if $self->{'inner'}; - #my %opts = %$self; + my $filename = $self->{'filename'}; + my $pkg = $self->{'package'}; + # Get the exception params instantiated + $self->_setup_exceptions; - # check to see if we're running under test - my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC; + # automatically turn a scalar search path or namespace into a arrayref + for (qw(search_path search_dirs)) { + $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); + } - # add any search_dir params - unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; + # default search path is '<Module>::<Name>::Plugin' + $self->{'search_path'} ||= ["${pkg}::Plugin"]; + # default error handler + $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; + $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; - my @plugins = $self->search_directories(@SEARCHDIR); - push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; + # default whether to follow symlinks + $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; - # push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$self->{'search_path'}}); - - # return blank unless we've found anything - return () unless @plugins; + # check to see if we're running under test + my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; + # add any search_dir params + unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; + # set our @INC up to include and prefer our search_dirs if necessary + my @tmp = @INC; + unshift @tmp, @{$self->{'search_dirs'} || []}; + local @INC = @tmp if defined $self->{'search_dirs'}; - # remove duplicates - # probably not necessary but hey ho - my %plugins; - for(@plugins) { - next unless $self->_is_legit($_); - $plugins{$_} = 1; - } + my @plugins = $self->search_directories(@SEARCHDIR); + push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; + + # return blank unless we've found anything + return () unless @plugins; + + # remove duplicates + # probably not necessary but hey ho + my %plugins; + for(@plugins) { + next unless $self->_is_legit($_); + $plugins{$_} = 1; + } - # are we instantiating or requring? - if (defined $self->{'instantiate'}) { - my $method = $self->{'instantiate'}; - return map { ($_->can($method)) ? $_->$method(@_) : () } keys %plugins; - } else { - # no? just return the names - return keys %plugins; + # are we instantiating or requring? + if (defined $self->{'instantiate'}) { + my $method = $self->{'instantiate'}; + my @objs = (); + foreach my $package (sort keys %plugins) { + next unless $package->can($method); + my $obj = eval { $package->$method(@_) }; + $self->{'on_instantiate_error'}->($package, $@) if $@; + push @objs, $obj if $obj; } - - + return @objs; + } else { + # no? just return the names + my @objs= sort keys %plugins; + return @objs; + } } sub _setup_exceptions { @@ -127,12 +139,16 @@ sub _is_legit { my %except = %{$self->{_exceptions}->{except_hash}||{}}; my $only = $self->{_exceptions}->{only}; my $except = $self->{_exceptions}->{except}; + my $depth = () = split '::', $plugin, -1; return 0 if (keys %only && !$only{$plugin} ); return 0 unless (!defined $only || $plugin =~ m!$only! ); return 0 if (keys %except && $except{$plugin} ); return 0 if (defined $except && $plugin =~ m!$except! ); + + return 0 if defined $self->{max_depth} && $depth>$self->{max_depth}; + return 0 if defined $self->{min_depth} && $depth<$self->{min_depth}; return 1; } @@ -193,7 +209,7 @@ sub search_paths { next if ($in_pod || $line =~ /^=cut/); # skip pod text next if $line =~ /^\s*#/; # and comments if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { - @pkg_dirs = split /::/, $1; + @pkg_dirs = split /::/, $1 if defined $1;; $name = $2; last; } @@ -220,10 +236,7 @@ sub search_paths { next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i; - my $err = $self->handle_finding_plugin($plugin); - carp "Couldn't require $plugin : $err" if $err; - - push @plugins, $plugin; + $self->handle_finding_plugin($plugin, \@plugins) } # now add stuff that may have been in package @@ -252,12 +265,33 @@ sub _is_editor_junk { } sub handle_finding_plugin { - my $self = shift; - my $plugin = shift; - - return unless (defined $self->{'instantiate'} || $self->{'require'}); + my $self = shift; + my $plugin = shift; + my $plugins = shift; + my $no_req = shift || 0; + return unless $self->_is_legit($plugin); - $self->_require($plugin); + unless (defined $self->{'instantiate'} || $self->{'require'}) { + push @$plugins, $plugin; + return; + } + + $self->{before_require}->($plugin) || return if defined $self->{before_require}; + unless ($no_req) { + my $tmp = $@; + my $res = eval { $self->_require($plugin) }; + my $err = $@; + $@ = $tmp; + if ($err) { + if (defined $self->{on_require_error}) { + $self->{on_require_error}->($plugin, $err) || return; + } else { + return; + } + } + } + $self->{after_require}->($plugin) || return if defined $self->{after_require}; + push @$plugins, $plugin; } sub find_files { @@ -273,7 +307,8 @@ sub find_files { { # for the benefit of perl 5.6.1's Find, localize topic local $_; File::Find::find( { no_chdir => 1, - wanted => sub { + follow => $self->{'follow_symlinks'}, + wanted => sub { # Inlined from File::Find::Rule C< name => '*.pm' > return unless $File::Find::name =~ /$file_regex/; (my $path = $File::Find::name) =~ s#^\\./##; @@ -294,10 +329,7 @@ sub handle_innerpackages { my @plugins; foreach my $plugin (Devel::InnerPackage::list_packages($path)) { - my $err = $self->handle_finding_plugin($plugin); - #next if $err; - #next unless $INC{$plugin}; - push @plugins, $plugin; + $self->handle_finding_plugin($plugin, \@plugins, 1); } return @plugins; @@ -305,11 +337,11 @@ sub handle_innerpackages { sub _require { - my $self = shift; - my $pack = shift; - local $@; + my $self = shift; + my $pack = shift; eval "CORE::require $pack"; - return $@; + die ($@) if $@; + return 1; } |