Perl 5.12.2 from CPAN

2 files changed, 728 insertions, 0 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
new file mode 100644
index 00000000000..bbdb49b6bca
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm
@@ -0,0 +1,355 @@
+package Module::Pluggable;
+
+use strict;
+use vars qw($VERSION);
+use Module::Pluggable::Object;
+
+# 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 = '3.9';
+
+sub import {
+    my $class        = shift;
+    my %opts         = @_;
+
+    my ($pkg, $file) = caller; 
+    # the default name for the method is 'plugins'
+    my $sub          = $opts{'sub_name'}  || 'plugins';
+    # get our package 
+    my ($package)    = $opts{'package'} || $pkg;
+    $opts{filename}  = $file;
+    $opts{package}   = $package;
+
+
+    my $finder       = Module::Pluggable::Object->new(%opts);
+    my $subroutine   = sub { my $self = shift; return $finder->plugins(@_) };
+
+    my $searchsub = sub {
+              my $self = shift;
+              my ($action,@paths) = @_;
+
+              $finder->{'search_path'} = ["${package}::Plugin"] if ($action eq 'add'  and not   $finder->{'search_path'} );
+              push @{$finder->{'search_path'}}, @paths      if ($action eq 'add');
+              $finder->{'search_path'}       = \@paths      if ($action eq 'new');
+              return $finder->{'search_path'};
+    };
+
+
+    my $onlysub = sub {
+        my ($self, $only) = @_;
+
+        if (defined $only) {
+            $finder->{'only'} = $only;
+        };
+        
+        return $finder->{'only'};
+    };
+
+    my $exceptsub = sub {
+        my ($self, $except) = @_;
+
+        if (defined $except) {
+            $finder->{'except'} = $except;
+        };
+        
+        return $finder->{'except'};
+    };
+
+
+    no strict 'refs';
+    no warnings qw(redefine prototype);
+    
+    *{"$package\::$sub"}        = $subroutine;
+    *{"$package\::search_path"} = $searchsub;
+    *{"$package\::only"}        = $onlysub;
+    *{"$package\::except"}      = $exceptsub;
+
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+Module::Pluggable - automatically give your module the ability to have plugins
+
+=head1 SYNOPSIS
+
+
+Simple use Module::Pluggable -
+
+    package MyClass;
+    use Module::Pluggable;
+    
+
+and then later ...
+
+    use MyClass;
+    my $mc = MyClass->new();
+    # returns the names of all plugins installed under MyClass::Plugin::*
+    my @plugins = $mc->plugins(); 
+
+=head1 EXAMPLE
+
+Why would you want to do this? Say you have something that wants to pass an
+object to a number of different plugins in turn. For example you may 
+want to extract meta-data from every email you get sent and do something
+with it. Plugins make sense here because then you can keep adding new 
+meta data parsers and all the logic and docs for each one will be 
+self contained and new handlers are easy to add without changing the 
+core code. For that, you might do something like ...
+
+    package Email::Examiner;
+
+    use strict;
+    use Email::Simple;
+    use Module::Pluggable require => 1;
+
+    sub handle_email {
+        my $self  = shift;
+        my $email = shift;
+
+        foreach my $plugin ($self->plugins) {
+            $plugin->examine($email);
+        }
+
+        return 1;
+    }
+
+
+
+.. and all the plugins will get a chance in turn to look at it.
+
+This can be trivally extended so that plugins could save the email
+somewhere and then no other plugin should try and do that. 
+Simply have it so that the C<examine> method returns C<1> if 
+it has saved the email somewhere. You might also wnat to be paranoid
+and check to see if the plugin has an C<examine> method.
+
+        foreach my $plugin ($self->plugins) {
+            next unless $plugin->can('examine');
+            last if     $plugin->examine($email);
+        }
+
+
+And so on. The sky's the limit.
+
+
+=head1 DESCRIPTION
+
+Provides a simple but, hopefully, extensible way of having 'plugins' for 
+your module. Obviously this isn't going to be the be all and end all of
+solutions but it works for me.
+
+Essentially all it does is export a method into your namespace that 
+looks through a search path for .pm files and turn those into class names. 
+
+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';
+
+
+and then later ...
+
+    my @plugins = $mc->foo();
+
+
+Or if you want to look in another namespace
+
+    package MyClass;
+    use Module::Pluggable search_path => ['Acme::MyClass::Plugin', 'MyClass::Extend'];
+
+or directory 
+
+    use Module::Pluggable search_dirs => ['mylibs/Foo'];
+
+
+Or if you want to instantiate each plugin rather than just return the name
+
+    package MyClass;
+    use Module::Pluggable instantiate => 'new';
+
+and then
+
+    # whatever is passed to 'plugins' will be passed 
+    # to 'new' for each plugin 
+    my @plugins = $mc->plugins(@options); 
+
+
+alternatively you can just require the module without instantiating it
+
+    package MyClass;
+    use Module::Pluggable require => 1;
+
+since requiring automatically searches inner packages, which may not be desirable, you can turn this off
+
+
+    package MyClass;
+    use Module::Pluggable require => 1, inner => 0;
+
+
+You can limit the plugins loaded using the except option, either as a string,
+array ref or regex
+
+    package MyClass;
+    use Module::Pluggable except => 'MyClass::Plugin::Foo';
+
+or
+
+    package MyClass;
+    use Module::Pluggable except => ['MyClass::Plugin::Foo', 'MyClass::Plugin::Bar'];
+
+or
+
+    package MyClass;
+    use Module::Pluggable except => qr/^MyClass::Plugin::(Foo|Bar)$/;
+
+
+and similarly for only which will only load plugins which match.
+
+Remember you can use the module more than once
+
+    package MyClass;
+    use Module::Pluggable search_path => 'MyClass::Filters' sub_name => 'filters';
+    use Module::Pluggable search_path => 'MyClass::Plugins' sub_name => 'plugins';
+
+and then later ...
+
+    my @filters = $self->filters;
+    my @plugins = $self->plugins;
+
+=head1 INNER PACKAGES
+
+If you have, for example, a file B<lib/Something/Plugin/Foo.pm> that
+contains package definitions for both C<Something::Plugin::Foo> and 
+C<Something::Plugin::Bar> then as long as you either have either 
+the B<require> or B<instantiate> option set then we'll also find 
+C<Something::Plugin::Bar>. Nifty!
+
+=head1 OPTIONS
+
+You can pass a hash of options when importing this module.
+
+The options can be ...
+
+=head2 sub_name
+
+The name of the subroutine to create in your namespace. 
+
+By default this is 'plugins'
+
+=head2 search_path
+
+An array ref of namespaces to look in. 
+
+=head2 search_dirs 
+
+An array ref of directorys to look in before @INC.
+
+=head2 instantiate
+
+Call this method on the class. In general this will probably be 'new'
+but it can be whatever you want. Whatever arguments are passed to 'plugins' 
+will be passed to the method.
+
+The default is 'undef' i.e just return the class name.
+
+=head2 require
+
+Just require the class, don't instantiate (overrides 'instantiate');
+
+=head2 inner
+
+If set to 0 will B<not> search inner packages. 
+If set to 1 will override C<require>.
+
+=head2 only
+
+Takes a string, array ref or regex describing the names of the only plugins to 
+return. Whilst this may seem perverse ... well, it is. But it also 
+makes sense. Trust me.
+
+=head2 except
+
+Similar to C<only> it takes a description of plugins to exclude 
+from returning. This is slightly less perverse.
+
+=head2 package
+
+This is for use by extension modules which build on C<Module::Pluggable>:
+passing a C<package> option allows you to place the plugin method in a
+different package other than your own.
+
+=head2 file_regex
+
+By default C<Module::Pluggable> only looks for I<.pm> files.
+
+By supplying a new C<file_regex> then you can change this behaviour e.g
+
+    file_regex => qr/\.plugin$/
+
+=head2 include_editor_junk
+
+By default C<Module::Pluggable> ignores files that look like they were
+left behind by editors. Currently this means files ending in F<~> (~),
+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.
+
+
+=head1 METHODs
+
+=head2 search_path
+
+The method C<search_path> is exported into you namespace as well. 
+You can call that at any time to change or replace the 
+search_path.
+
+    $self->search_path( add => "New::Path" ); # add
+    $self->search_path( new => "New::Path" ); # replace
+
+
+
+=head1 FUTURE PLANS
+
+This does everything I need and I can't really think of any other 
+features I want to add. Famous last words of course
+
+Recently tried fixed to find inner packages and to make it 
+'just work' with PAR but there are still some issues.
+
+
+However suggestions (and patches) are welcome.
+
+=head1 AUTHOR
+
+Simon Wistow <simon@thegestalt.org>
+
+=head1 COPYING
+
+Copyright, 2006 Simon Wistow
+
+Distributed under the same terms as Perl itself.
+
+=head1 BUGS
+
+None known.
+
+=head1 SEE ALSO
+
+L<File::Spec>, L<File::Find>, L<File::Basename>, L<Class::Factory::Util>, L<Module::Pluggable::Ordered>
+
+=cut 
+
+
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
new file mode 100644
index 00000000000..e0ee993075d
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm
@@ -0,0 +1,373 @@
+package Module::Pluggable::Object;
+
+use strict;
+use File::Find ();
+use File::Basename;
+use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel);
+use Carp qw(croak carp);
+use Devel::InnerPackage;
+use vars qw($VERSION);
+
+$VERSION = '3.9';
+
+
+sub new {
+    my $class = shift;
+    my %opts  = @_;
+
+    return bless \%opts, $class;
+
+}
+
+### Eugggh, this code smells 
+### This is what happens when you keep adding patches
+### *sigh*
+
+
+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 %opts = %$self;
+
+
+        # check to see if we're running under test
+        my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC;
+
+        # add any search_dir params
+        unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'};
+
+
+        my @plugins = $self->search_directories(@SEARCHDIR);
+        push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}};
+
+        # push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) 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;
+        }
+
+
+}
+
+sub _setup_exceptions {
+    my $self = shift;
+
+    my %only;   
+    my %except; 
+    my $only;
+    my $except;
+
+    if (defined $self->{'only'}) {
+        if (ref($self->{'only'}) eq 'ARRAY') {
+            %only   = map { $_ => 1 } @{$self->{'only'}};
+        } elsif (ref($self->{'only'}) eq 'Regexp') {
+            $only = $self->{'only'}
+        } elsif (ref($self->{'only'}) eq '') {
+            $only{$self->{'only'}} = 1;
+        }
+    }
+        
+
+    if (defined $self->{'except'}) {
+        if (ref($self->{'except'}) eq 'ARRAY') {
+            %except   = map { $_ => 1 } @{$self->{'except'}};
+        } elsif (ref($self->{'except'}) eq 'Regexp') {
+            $except = $self->{'except'}
+        } elsif (ref($self->{'except'}) eq '') {
+            $except{$self->{'except'}} = 1;
+        }
+    }
+    $self->{_exceptions}->{only_hash}   = \%only;
+    $self->{_exceptions}->{only}        = $only;
+    $self->{_exceptions}->{except_hash} = \%except;
+    $self->{_exceptions}->{except}      = $except;
+        
+}
+
+sub _is_legit {
+    my $self   = shift;
+    my $plugin = shift;
+    my %only   = %{$self->{_exceptions}->{only_hash}||{}};
+    my %except = %{$self->{_exceptions}->{except_hash}||{}};
+    my $only   = $self->{_exceptions}->{only};
+    my $except = $self->{_exceptions}->{except};
+
+    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 1;
+}
+
+sub search_directories {
+    my $self      = shift;
+    my @SEARCHDIR = @_;
+
+    my @plugins;
+    # go through our @INC
+    foreach my $dir (@SEARCHDIR) {
+        push @plugins, $self->search_paths($dir);
+    }
+    return @plugins;
+}
+
+
+sub search_paths {
+    my $self = shift;
+    my $dir  = shift;
+    my @plugins;
+
+    my $file_regex = $self->{'file_regex'} || qr/\.pm$/;
+
+
+    # and each directory in our search path
+    foreach my $searchpath (@{$self->{'search_path'}}) {
+        # create the search directory in a cross platform goodness way
+        my $sp = catdir($dir, (split /::/, $searchpath));
+
+        # if it doesn't exist or it's not a dir then skip it
+        next unless ( -e $sp && -d _ ); # Use the cached stat the second time
+
+        my @files = $self->find_files($sp);
+
+        # foreach one we've found 
+        foreach my $file (@files) {
+            # untaint the file; accept .pm only
+            next unless ($file) = ($file =~ /(.*$file_regex)$/); 
+            # parse the file to get the name
+            my ($name, $directory, $suffix) = fileparse($file, $file_regex);
+
+            next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name));
+
+            $directory = abs2rel($directory, $sp);
+
+            # If we have a mixed-case package name, assume case has been preserved
+            # correctly.  Otherwise, root through the file to locate the case-preserved
+            # version of the package name.
+            my @pkg_dirs = ();
+            if ( $name eq lc($name) || $name eq uc($name) ) {
+                my $pkg_file = catfile($sp, $directory, "$name$suffix");
+                open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!";
+                my $in_pod = 0;
+                while ( my $line = <PKGFILE> ) {
+                    $in_pod = 1 if $line =~ m/^=\w/;
+                    $in_pod = 0 if $line =~ /^=cut/;
+                    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;
+                        $name = $2;
+                        last;
+                    }
+                }
+                close PKGFILE;
+            }
+
+            # then create the class name in a cross platform way
+            $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/);       # remove volume
+            my @dirs = ();
+            if ($directory) {
+                ($directory) = ($directory =~ /(.*)/);
+                @dirs = grep(length($_), splitdir($directory)) 
+                    unless $directory eq curdir();
+                for my $d (reverse @dirs) {
+                    my $pkg_dir = pop @pkg_dirs; 
+                    last unless defined $pkg_dir;
+                    $d =~ s/\Q$pkg_dir\E/$pkg_dir/i;  # Correct case
+                }
+            } else {
+                $directory = "";
+            }
+            my $plugin = join '::', $searchpath, @dirs, $name;
+
+            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;
+        }
+
+        # now add stuff that may have been in package
+        # NOTE we should probably use all the stuff we've been given already
+        # but then we can't unload it :(
+        push @plugins, $self->handle_innerpackages($searchpath);
+    } # foreach $searchpath
+
+    return @plugins;
+}
+
+sub _is_editor_junk {
+    my $self = shift;
+    my $name = shift;
+
+    # Emacs (and other Unix-y editors) leave temp files ending in a
+    # tilde as a backup.
+    return 1 if $name =~ /~$/;
+    # Emacs makes these files while a buffer is edited but not yet
+    # saved.
+    return 1 if $name =~ /^\.#/;
+    # Vim can leave these files behind if it crashes.
+    return 1 if $name =~ /\.sw[po]$/;
+
+    return 0;
+}
+
+sub handle_finding_plugin {
+    my $self   = shift;
+    my $plugin = shift;
+
+    return unless (defined $self->{'instantiate'} || $self->{'require'}); 
+    return unless $self->_is_legit($plugin);
+    $self->_require($plugin);
+}
+
+sub find_files {
+    my $self         = shift;
+    my $search_path  = shift;
+    my $file_regex   = $self->{'file_regex'} || qr/\.pm$/;
+
+
+    # find all the .pm files in it
+    # this isn't perfect and won't find multiple plugins per file
+    #my $cwd = Cwd::getcwd;
+    my @files = ();
+    { # for the benefit of perl 5.6.1's Find, localize topic
+        local $_;
+        File::Find::find( { no_chdir => 1, 
+                           wanted => sub { 
+                             # Inlined from File::Find::Rule C< name => '*.pm' >
+                             return unless $File::Find::name =~ /$file_regex/;
+                             (my $path = $File::Find::name) =~ s#^\\./##;
+                             push @files, $path;
+                           }
+                      }, $search_path );
+    }
+    #chdir $cwd;
+    return @files;
+
+}
+
+sub handle_innerpackages {
+    my $self = shift;
+    return () if (exists $self->{inner} && !$self->{inner});
+
+    my $path = shift;
+    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;
+    }
+    return @plugins;
+
+}
+
+
+sub _require {
+    my $self = shift;
+    my $pack = shift;
+    local $@;
+    eval "CORE::require $pack";
+    return $@;
+}
+
+
+1;
+
+=pod
+
+=head1 NAME
+
+Module::Pluggable::Object - automatically give your module the ability to have plugins
+
+=head1 SYNOPSIS
+
+
+Simple use Module::Pluggable -
+
+    package MyClass;
+    use Module::Pluggable::Object;
+    
+    my $finder = Module::Pluggable::Object->new(%opts);
+    print "My plugins are: ".join(", ", $finder->plugins)."\n";
+
+=head1 DESCRIPTION
+
+Provides a simple but, hopefully, extensible way of having 'plugins' for 
+your module. Obviously this isn't going to be the be all and end all of
+solutions but it works for me.
+
+Essentially all it does is export a method into your namespace that 
+looks through a search path for .pm files and turn those into class names. 
+
+Optionally it instantiates those classes for you.
+
+This object is wrapped by C<Module::Pluggable>. If you want to do something
+odd or add non-general special features you're probably best to wrap this
+and produce your own subclass.
+
+=head1 OPTIONS
+
+See the C<Module::Pluggable> docs.
+
+=head1 AUTHOR
+
+Simon Wistow <simon@thegestalt.org>
+
+=head1 COPYING
+
+Copyright, 2006 Simon Wistow
+
+Distributed under the same terms as Perl itself.
+
+=head1 BUGS
+
+None known.
+
+=head1 SEE ALSO
+
+L<Module::Pluggable>
+
+=cut 
+