Import perl-5.18.2

OK espie@ sthen@ deraadt@

2 files changed, 204 insertions, 70 deletions

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;
 }