Add Module::Pluggable
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 28 Nov 2006 13:50:37 +0000 (13:50 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 28 Nov 2006 13:50:37 +0000 (13:50 +0000)
(required by CPANPLUS)

p4raw-id: //depot/perl@29404

53 files changed:
MANIFEST
lib/Module/Pluggable.pm [new file with mode: 0644]
lib/Module/Pluggable/Object.pm [new file with mode: 0644]
lib/Module/Pluggable/t/01use.t [new file with mode: 0644]
lib/Module/Pluggable/t/02alsoworks.t [new file with mode: 0644]
lib/Module/Pluggable/t/02works.t [new file with mode: 0644]
lib/Module/Pluggable/t/02works_taint.t [new file with mode: 0644]
lib/Module/Pluggable/t/03diffname.t [new file with mode: 0644]
lib/Module/Pluggable/t/04acmedir.t [new file with mode: 0644]
lib/Module/Pluggable/t/04acmedir_single.t [new file with mode: 0644]
lib/Module/Pluggable/t/04acmepath.t [new file with mode: 0644]
lib/Module/Pluggable/t/04acmepath_single.t [new file with mode: 0644]
lib/Module/Pluggable/t/05postpath.t [new file with mode: 0644]
lib/Module/Pluggable/t/06multipath.t [new file with mode: 0644]
lib/Module/Pluggable/t/07instantiate.t [new file with mode: 0644]
lib/Module/Pluggable/t/08nothing.t [new file with mode: 0644]
lib/Module/Pluggable/t/09require.t [new file with mode: 0644]
lib/Module/Pluggable/t/10innerpack.t [new file with mode: 0644]
lib/Module/Pluggable/t/10innerpack_inner.t [new file with mode: 0644]
lib/Module/Pluggable/t/10innerpack_noinner.t [new file with mode: 0644]
lib/Module/Pluggable/t/10innerpack_override.t [new file with mode: 0644]
lib/Module/Pluggable/t/11usetwice.t [new file with mode: 0644]
lib/Module/Pluggable/t/12only.t [new file with mode: 0644]
lib/Module/Pluggable/t/12onlyarray.t [new file with mode: 0644]
lib/Module/Pluggable/t/12onlyregex.t [new file with mode: 0644]
lib/Module/Pluggable/t/13except.t [new file with mode: 0644]
lib/Module/Pluggable/t/13exceptarray.t [new file with mode: 0644]
lib/Module/Pluggable/t/13exceptregex.t [new file with mode: 0644]
lib/Module/Pluggable/t/14package.t [new file with mode: 0644]
lib/Module/Pluggable/t/15topicsafe.t [new file with mode: 0644]
lib/Module/Pluggable/t/16different_extension.t [new file with mode: 0644]
lib/Module/Pluggable/t/17devel_inner_package.t [new file with mode: 0644]
lib/Module/Pluggable/t/18skipped_package.t [new file with mode: 0644]
lib/Module/Pluggable/t/19can_ok_clobber.t [new file with mode: 0644]
lib/Module/Pluggable/t/20dodgy_files.t [new file with mode: 0644]
lib/Module/Pluggable/t/acme/Acme/MyTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/Acme/MyTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/ExtTest/Plugin/Bar.plugin [new file with mode: 0644]
lib/Module/Pluggable/t/lib/ExtTest/Plugin/Foo.plugin [new file with mode: 0644]
lib/Module/Pluggable/t/lib/ExtTest/Plugin/Quux/Foo.plugin [new file with mode: 0644]
lib/Module/Pluggable/t/lib/InnerTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Bar.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyTest/Extend/Plugin/Bar.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyTest/Plugin/Bar.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/MyTest/Plugin/Quux/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/No/Middle.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/OddTest/Plugin/-Dodgy.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/OddTest/Plugin/Foo.pm [new file with mode: 0644]
lib/Module/Pluggable/t/lib/TA/C/A/I.pm [new file with mode: 0644]

index ea1068a..38ca45f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2035,6 +2035,58 @@ lib/Module/Load/t/to_load/LoadMe.pl      Module::Load tests
 lib/Module/Load/t/to_load/Must/Be/Loaded.pm    Module::Load tests
 lib/Module/Load/t/to_load/TestModule.pm        Module::Load tests
 lib/Module/Load/t/to_load/ToBeLoaded   Module::Load tests
+lib/Module/Pluggable/Object.pm Module::Pluggable
+lib/Module/Pluggable.pm        Module::Pluggable
+lib/Module/Pluggable/t/01use.t Module::Pluggable tests
+lib/Module/Pluggable/t/02alsoworks.t   Module::Pluggable tests
+lib/Module/Pluggable/t/02works.t       Module::Pluggable tests
+lib/Module/Pluggable/t/02works_taint.t Module::Pluggable tests
+lib/Module/Pluggable/t/03diffname.t    Module::Pluggable tests
+lib/Module/Pluggable/t/04acmedir_single.t      Module::Pluggable tests
+lib/Module/Pluggable/t/04acmedir.t     Module::Pluggable tests
+lib/Module/Pluggable/t/04acmepath_single.t     Module::Pluggable tests
+lib/Module/Pluggable/t/04acmepath.t    Module::Pluggable tests
+lib/Module/Pluggable/t/05postpath.t    Module::Pluggable tests
+lib/Module/Pluggable/t/06multipath.t   Module::Pluggable tests
+lib/Module/Pluggable/t/07instantiate.t Module::Pluggable tests
+lib/Module/Pluggable/t/08nothing.t     Module::Pluggable tests
+lib/Module/Pluggable/t/09require.t     Module::Pluggable tests
+lib/Module/Pluggable/t/10innerpack_inner.t     Module::Pluggable tests
+lib/Module/Pluggable/t/10innerpack_noinner.t   Module::Pluggable tests
+lib/Module/Pluggable/t/10innerpack_override.t  Module::Pluggable tests
+lib/Module/Pluggable/t/10innerpack.t   Module::Pluggable tests
+lib/Module/Pluggable/t/11usetwice.t    Module::Pluggable tests
+lib/Module/Pluggable/t/12onlyarray.t   Module::Pluggable tests
+lib/Module/Pluggable/t/12onlyregex.t   Module::Pluggable tests
+lib/Module/Pluggable/t/12only.t        Module::Pluggable tests
+lib/Module/Pluggable/t/13exceptarray.t Module::Pluggable tests
+lib/Module/Pluggable/t/13exceptregex.t Module::Pluggable tests
+lib/Module/Pluggable/t/13except.t      Module::Pluggable tests
+lib/Module/Pluggable/t/14package.t     Module::Pluggable tests
+lib/Module/Pluggable/t/15topicsafe.t   Module::Pluggable tests
+lib/Module/Pluggable/t/16different_extension.t Module::Pluggable tests
+lib/Module/Pluggable/t/17devel_inner_package.t Module::Pluggable tests
+lib/Module/Pluggable/t/18skipped_package.t     Module::Pluggable tests
+lib/Module/Pluggable/t/19can_ok_clobber.t      Module::Pluggable tests
+lib/Module/Pluggable/t/20dodgy_files.t Module::Pluggable tests
+lib/Module/Pluggable/t/acme/Acme/MyTest/Plugin/Foo.pm  Module::Pluggable tests
+lib/Module/Pluggable/t/lib/Acme/MyTest/Plugin/Foo.pm   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/ExtTest/Plugin/Bar.plugin   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/ExtTest/Plugin/Foo.plugin   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/ExtTest/Plugin/Quux/Foo.plugin      Module::Pluggable tests
+lib/Module/Pluggable/t/lib/InnerTest/Plugin/Foo.pm     Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Bar.pm   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Foo.pm   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux/Foo.pm      Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux.pm  Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyTest/Extend/Plugin/Bar.pm Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyTest/Plugin/Bar.pm        Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyTest/Plugin/Foo.pm        Module::Pluggable tests
+lib/Module/Pluggable/t/lib/MyTest/Plugin/Quux/Foo.pm   Module::Pluggable tests
+lib/Module/Pluggable/t/lib/No/Middle.pm        Module::Pluggable tests
+lib/Module/Pluggable/t/lib/OddTest/Plugin/-Dodgy.pm    Module::Pluggable tests
+lib/Module/Pluggable/t/lib/OddTest/Plugin/Foo.pm       Module::Pluggable tests
+lib/Module/Pluggable/t/lib/TA/C/A/I.pm Module::Pluggable tests
 lib/Net/Changes.libnet         libnet
 lib/Net/Cmd.pm                 libnet
 lib/Net/Config.eg              libnet
diff --git a/lib/Module/Pluggable.pm b/lib/Module/Pluggable.pm
new file mode 100644 (file)
index 0000000..b24a119
--- /dev/null
@@ -0,0 +1,346 @@
+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.4';
+
+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 'redefine';
+    *{"$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$/
+
+
+
+=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/lib/Module/Pluggable/Object.pm b/lib/Module/Pluggable/Object.pm
new file mode 100644 (file)
index 0000000..564ef34
--- /dev/null
@@ -0,0 +1,285 @@
+package Module::Pluggable::Object;
+
+use strict;
+use File::Find ();
+use File::Basename;
+use File::Spec::Functions qw(splitdir catdir abs2rel);
+use Carp qw(croak carp);
+use Devel::InnerPackage;
+use Data::Dumper;
+
+sub new {
+    my $class = shift;
+    my %opts  = @_;
+
+    return bless \%opts, $class;
+
+}
+
+
+sub plugins {
+        my $self = shift;
+
+        # override 'require'
+        $self->{'require'} = 1 if $self->{'inner'};
+
+        my $filename   = $self->{'filename'};
+        my $pkg        = $self->{'package'};
+
+        # 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"} && $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, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$self->{'search_path'}});
+        
+        # return blank unless we've found anything
+        return () unless @plugins;
+
+
+        # exceptions
+        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;
+            }
+        }
+
+
+        # remove duplicates
+        # probably not necessary but hey ho
+        my %plugins;
+        for(@plugins) {
+            next if (keys %only   && !$only{$_}     );
+            next unless (!defined $only || m!$only! );
+
+            next if (keys %except &&  $except{$_}   );
+            next if (defined $except &&  m!$except! );
+            $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 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) = fileparse($file, $file_regex);
+
+            $directory = abs2rel($directory, $sp);
+            # then create the class name in a cross platform way
+            $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/);       # remove volume
+            if ($directory) {
+                ($directory) = ($directory =~ /(.*)/);
+            } else {
+                $directory = "";
+            }
+            my $plugin = join "::", splitdir catdir($searchpath, $directory, $name);
+
+            next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i;
+
+            my $err = eval { $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) unless (exists $self->{inner} && !$self->{inner});
+    } # foreach $searchpath
+
+    return @plugins;
+}
+
+sub handle_finding_plugin {
+    my $self   = shift;
+    my $plugin = shift;
+
+    return unless (defined $self->{'instantiate'} || $self->{'require'}); 
+    $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;
+    my $path = shift;
+    my @plugins;
+
+
+    foreach my $plugin (Devel::InnerPackage::list_packages($path)) {
+        my $err = eval { $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;
+    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.
+
+=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 
+
diff --git a/lib/Module/Pluggable/t/01use.t b/lib/Module/Pluggable/t/01use.t
new file mode 100644 (file)
index 0000000..be0b848
--- /dev/null
@@ -0,0 +1,9 @@
+#!perl -w
+
+use strict;
+use Test::More tests => 3;
+
+use_ok('Module::Pluggable');
+use_ok('Module::Pluggable::Object');
+use_ok('Devel::InnerPackage');
+
diff --git a/lib/Module/Pluggable/t/02alsoworks.t b/lib/Module/Pluggable/t/02alsoworks.t
new file mode 100644 (file)
index 0000000..c7b00ad
--- /dev/null
@@ -0,0 +1,42 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = MyOtherTest->new());
+
+my @plugins;
+my @expected = qw(MyOtherTest::Plugin::Bar MyOtherTest::Plugin::Foo  MyOtherTest::Plugin::Quux MyOtherTest::Plugin::Quux::Foo);
+ok(@plugins = sort $foo->plugins);
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply");
+
+@plugins = ();
+
+ok(@plugins = sort MyOtherTest->plugins);
+
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply class");
+
+
+
+package MyOtherTest;
+
+use strict;
+use Module::Pluggable;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/02works.t b/lib/Module/Pluggable/t/02works.t
new file mode 100644 (file)
index 0000000..6c39452
--- /dev/null
@@ -0,0 +1,42 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Foo MyTest::Plugin::Quux::Foo);
+ok(@plugins = sort $foo->plugins);
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply");
+
+@plugins = ();
+
+ok(@plugins = sort MyTest->plugins);
+
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply class");
+
+
+
+package MyTest;
+
+use strict;
+use Module::Pluggable;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/02works_taint.t b/lib/Module/Pluggable/t/02works_taint.t
new file mode 100644 (file)
index 0000000..0e1baa3
--- /dev/null
@@ -0,0 +1,41 @@
+#!perl -wT
+
+# NOTE: Module::Pluggable is going into core
+# and CORE tests can't modify @INC under taint 
+# so this is a work around to make sure it
+# still works under taint checking.
+
+use strict;
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Module::Pluggable::Object);
+ok(@plugins = sort $foo->plugins);
+
+
+ok(grep {/Module::Pluggable::Object/} @plugins, "Contains Module::Pluggable::Object");
+
+@plugins = ();
+
+ok(@plugins = sort MyTest->plugins);
+
+ok(grep {/Module::Pluggable::Object/} @plugins, "Contains Module::Pluggable::Object under class method");
+
+
+
+package MyTest;
+
+use strict;
+use Module::Pluggable search_path => 'Module::Pluggable';
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/03diffname.t b/lib/Module/Pluggable/t/03diffname.t
new file mode 100644 (file)
index 0000000..b4a881b
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Foo MyTest::Plugin::Quux::Foo);
+ok(@plugins = sort $foo->foo);
+is_deeply(\@plugins, \@expected);
+
+
+
+package MyTest;
+
+use strict;
+use Module::Pluggable ( sub_name => 'foo');
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/04acmedir.t b/lib/Module/Pluggable/t/04acmedir.t
new file mode 100644 (file)
index 0000000..7154486
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Acme::MyTest::Plugin::Foo);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable search_path => ["Acme::MyTest::Plugin"], search_dirs => [ "t/acme" ];
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/04acmedir_single.t b/lib/Module/Pluggable/t/04acmedir_single.t
new file mode 100644 (file)
index 0000000..e2abce9
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Acme::MyTest::Plugin::Foo);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable search_path => "Acme::MyTest::Plugin", search_dirs => "t/acme" ;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/04acmepath.t b/lib/Module/Pluggable/t/04acmepath.t
new file mode 100644 (file)
index 0000000..bb1b88b
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Acme::MyTest::Plugin::Foo);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable (search_path => ["Acme::MyTest::Plugin"]);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/04acmepath_single.t b/lib/Module/Pluggable/t/04acmepath_single.t
new file mode 100644 (file)
index 0000000..bf02854
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Acme::MyTest::Plugin::Foo);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable search_path => "Acme::MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/05postpath.t b/lib/Module/Pluggable/t/05postpath.t
new file mode 100644 (file)
index 0000000..be16010
--- /dev/null
@@ -0,0 +1,31 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(MyTest::Extend::Plugin::Bar);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable (search_path => ["MyTest::Extend::Plugin"]);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/06multipath.t b/lib/Module/Pluggable/t/06multipath.t
new file mode 100644 (file)
index 0000000..4c9a16b
--- /dev/null
@@ -0,0 +1,33 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(Acme::MyTest::Plugin::Foo MyTest::Extend::Plugin::Bar);
+ok(@plugins = sort $foo->plugins);
+
+is_deeply(\@plugins, \@expected);
+
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use File::Spec::Functions qw(catdir);
+use Module::Pluggable (search_path => ["MyTest::Extend::Plugin", "Acme::MyTest::Plugin"]);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/07instantiate.t b/lib/Module/Pluggable/t/07instantiate.t
new file mode 100644 (file)
index 0000000..befc15a
--- /dev/null
@@ -0,0 +1,40 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 6;
+
+my $foo;
+ok($foo = MyTest->new());
+
+
+
+my @plugins;
+ok(@plugins = sort $foo->booga(nork => 'fark'));
+is(ref $plugins[0],'MyTest::Extend::Plugin::Bar');
+is($plugins[0]->nork,'fark');
+
+
+@plugins = ();
+eval { @plugins = $foo->wooga( nork => 'fark') };
+is($@, '');
+is(scalar(@plugins),0);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Module::Pluggable (search_path => ["MyTest::Extend::Plugin"], sub_name => 'booga', instantiate => 'new');
+use Module::Pluggable (search_path => ["MyTest::Extend::Plugin"], sub_name => 'wooga', instantiate => 'nosomuchmethod');
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/08nothing.t b/lib/Module/Pluggable/t/08nothing.t
new file mode 100644 (file)
index 0000000..78d1007
--- /dev/null
@@ -0,0 +1,30 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 2;
+
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @expected = ();
+my @plugins = sort $foo->plugins;
+is_deeply(\@plugins, \@expected);
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable (search_path => ["No::Such::Modules"]);
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/09require.t b/lib/Module/Pluggable/t/09require.t
new file mode 100644 (file)
index 0000000..106e2c4
--- /dev/null
@@ -0,0 +1,29 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 2;
+
+my $t = MyTest->new();
+
+
+ok($t->plugins());
+
+ok(keys %{MyTest::Plugin::Foo::});
+
+
+package MyTest;
+use File::Spec::Functions qw(catdir);
+use strict;
+use Module::Pluggable (require => 1);
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/10innerpack.t b/lib/Module/Pluggable/t/10innerpack.t
new file mode 100644 (file)
index 0000000..fc7a213
--- /dev/null
@@ -0,0 +1,35 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 4;
+
+
+
+my $t = InnerTest->new();
+
+my %plugins = map { $_ => 1 } $t->plugins;
+
+ok(keys %plugins, "Got some plugins");
+ok($plugins{'InnerTest::Plugin::Foo'}, "Got Foo");
+ok($plugins{'InnerTest::Plugin::Bar'}, "Got Bar - the inner package");
+ok($plugins{'InnerTest::Plugin::Quux'}, "Got Quux - the other inner package");
+
+
+
+package InnerTest;
+use strict;
+use Module::Pluggable require => 1;
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/10innerpack_inner.t b/lib/Module/Pluggable/t/10innerpack_inner.t
new file mode 100644 (file)
index 0000000..55edcd9
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+
+my $t = InnerTest->new();
+
+my %plugins = map { $_ => 1 } $t->plugins;
+
+ok(keys %plugins, "Got some plugins");
+ok($plugins{'InnerTest::Plugin::Foo'}, "Got Foo");
+ok($plugins{'InnerTest::Plugin::Bar'}, "Got Bar - the inner package");
+
+
+
+package InnerTest;
+use strict;
+use Module::Pluggable inner => 1;
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/10innerpack_noinner.t b/lib/Module/Pluggable/t/10innerpack_noinner.t
new file mode 100644 (file)
index 0000000..5d40cd5
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+
+my $t = InnerTest->new();
+
+my %plugins = map { $_ => 1 } $t->plugins;
+
+ok(keys %plugins, "Got some plugins");
+ok($plugins{'InnerTest::Plugin::Foo'}, "Got Foo");
+ok(!$plugins{'InnerTest::Plugin::Bar'}, "Didn't get Bar - the inner package");
+
+
+
+package InnerTest;
+use strict;
+use Module::Pluggable require => 1, inner => 0;
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/10innerpack_override.t b/lib/Module/Pluggable/t/10innerpack_override.t
new file mode 100644 (file)
index 0000000..039b845
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+
+
+my $t = InnerTest->new();
+
+my %plugins = map { $_ => 1 } $t->plugins;
+
+ok(keys %plugins, "Got some plugins");
+ok($plugins{'InnerTest::Plugin::Foo'}, "Got Foo");
+ok($plugins{'InnerTest::Plugin::Bar'}, "Got Bar - the inner package");
+
+
+
+package InnerTest;
+use strict;
+use Module::Pluggable require => 0, inner => 1;
+use base qw(Module::Pluggable);
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/11usetwice.t b/lib/Module/Pluggable/t/11usetwice.t
new file mode 100644 (file)
index 0000000..0f6a1ba
--- /dev/null
@@ -0,0 +1,44 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 3;
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(MyTest::Extend::Plugin::Bar MyTest::Plugin::Bar MyTest::Plugin::Foo MyTest::Plugin::Quux::Foo);
+
+push @plugins,  $foo->plugins;
+push @plugins, $foo->foo;
+
+@plugins = sort @plugins;
+is_deeply(\@plugins, \@expected);
+
+@plugins = ();
+
+push @plugins,  MyTest->plugins;
+push @plugins,  MyTest->foo; 
+@plugins = sort @plugins;
+is_deeply(\@plugins, \@expected);
+
+
+
+package MyTest;
+
+use strict;
+use Module::Pluggable;
+use Module::Pluggable ( search_path => [ "MyTest::Extend::Plugin" ] , sub_name => 'foo' );
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/12only.t b/lib/Module/Pluggable/t/12only.t
new file mode 100644 (file)
index 0000000..6164c42
--- /dev/null
@@ -0,0 +1,64 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable only => "MyTest::Plugin::Foo";
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->only("MyTest::Plugin::Foo");
+
+    return $self;
+}
+1;
diff --git a/lib/Module/Pluggable/t/12onlyarray.t b/lib/Module/Pluggable/t/12onlyarray.t
new file mode 100644 (file)
index 0000000..5ecc654
--- /dev/null
@@ -0,0 +1,65 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable only => [ "MyTest::Plugin::Foo" ];
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->only(["MyTest::Plugin::Foo"]);
+
+    return $self;
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/12onlyregex.t b/lib/Module/Pluggable/t/12onlyregex.t
new file mode 100644 (file)
index 0000000..eff6a16
--- /dev/null
@@ -0,0 +1,65 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Foo);
+    ok(@plugins = sort $foo->plugins);
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable only => qr/MyTest::Plugin::Foo$/;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->only(qr/MyTest::Plugin::Foo$/);
+
+    return $self;
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/13except.t b/lib/Module/Pluggable/t/13except.t
new file mode 100644 (file)
index 0000000..0dbfb20
--- /dev/null
@@ -0,0 +1,68 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable except => "MyTest::Plugin::Foo";
+
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->except("MyTest::Plugin::Foo");
+
+    return $self;
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/13exceptarray.t b/lib/Module/Pluggable/t/13exceptarray.t
new file mode 100644 (file)
index 0000000..a6313bd
--- /dev/null
@@ -0,0 +1,68 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable except => [ "MyTest::Plugin::Foo" ];
+
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->except(["MyTest::Plugin::Foo"]);
+
+    return $self;
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/13exceptregex.t b/lib/Module/Pluggable/t/13exceptregex.t
new file mode 100644 (file)
index 0000000..e3f2638
--- /dev/null
@@ -0,0 +1,68 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 10;
+
+{
+    my $foo;
+    ok($foo = MyTest->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTest->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+{
+    my $foo;
+    ok($foo = MyTestSub->new());
+
+    my @plugins;
+    my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Quux::Foo);
+    ok(@plugins = sort $foo->plugins);
+
+    is_deeply(\@plugins, \@expected);
+
+    @plugins = ();
+
+    ok(@plugins = sort MyTestSub->plugins);
+    is_deeply(\@plugins, \@expected);
+}
+
+package MyTest;
+
+use strict;
+use Module::Pluggable except => qr/MyTest::Plugin::Foo/;
+
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+package MyTestSub;
+
+use strict;
+use Module::Pluggable search_path => "MyTest::Plugin";
+
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+
+    $self->except(qr/MyTest::Plugin::Foo/);
+
+    return $self;
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/14package.t b/lib/Module/Pluggable/t/14package.t
new file mode 100644 (file)
index 0000000..3ba56ed
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = MyTest->new());
+
+my @plugins;
+my @expected = qw(MyTest::Plugin::Bar MyTest::Plugin::Foo MyTest::Plugin::Quux::Foo);
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected);
+
+@plugins = ();
+
+ok(@plugins = sort MyTest->plugins);
+is_deeply(\@plugins, \@expected);
+
+
+
+package MyTest;
+use strict;
+sub new { return bless {}, $_[0] }
+
+package MyOtherTest;
+use strict;
+use Module::Pluggable ( package => "MyTest" );
+sub new { return bless {}, $_[0] }
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/15topicsafe.t b/lib/Module/Pluggable/t/15topicsafe.t
new file mode 100644 (file)
index 0000000..abc980f
--- /dev/null
@@ -0,0 +1,16 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More 'no_plan';
+
+use Module::Pluggable search_path => 'Acme::MyTest';
+
+my $topic = "topic";
+
+for ($topic) {
+  main->plugins;
+}
+
+is($topic, 'topic', "we've got the right topic");
diff --git a/lib/Module/Pluggable/t/16different_extension.t b/lib/Module/Pluggable/t/16different_extension.t
new file mode 100644 (file)
index 0000000..3f1a4da
--- /dev/null
@@ -0,0 +1,42 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = ExtTest->new());
+
+my @plugins;
+my @expected = qw(ExtTest::Plugin::Bar ExtTest::Plugin::Foo ExtTest::Plugin::Quux::Foo);
+ok(@plugins = sort $foo->plugins);
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply");
+
+@plugins = ();
+
+ok(@plugins = sort ExtTest->plugins);
+
+
+
+
+is_deeply(\@plugins, \@expected, "is deeply class");
+
+
+
+package ExtTest;
+
+use strict;
+use Module::Pluggable file_regex => qr/\.plugin$/;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
diff --git a/lib/Module/Pluggable/t/17devel_inner_package.t b/lib/Module/Pluggable/t/17devel_inner_package.t
new file mode 100644 (file)
index 0000000..5fabdbf
--- /dev/null
@@ -0,0 +1,15 @@
+#!perl -w
+use Test::More tests => 3;
+
+use Devel::InnerPackage qw(list_packages);
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+my @packages;
+
+use_ok("TA::C::A::I");
+ok(@packages = list_packages("TA::C::A::I"));
+
+is_deeply([sort @packages], [qw(TA::C::A::I::A TA::C::A::I::A::B)]);
+
+
diff --git a/lib/Module/Pluggable/t/18skipped_package.t b/lib/Module/Pluggable/t/18skipped_package.t
new file mode 100644 (file)
index 0000000..3991772
--- /dev/null
@@ -0,0 +1,11 @@
+#!perl -w
+
+use Test::More tests => 1;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Devel::InnerPackage qw(list_packages);
+use No::Middle;
+
+my @p = list_packages("No::Middle");
+is_deeply([ sort @p ], [ qw(No::Middle::Package::A No::Middle::Package::B) ]);
diff --git a/lib/Module/Pluggable/t/19can_ok_clobber.t b/lib/Module/Pluggable/t/19can_ok_clobber.t
new file mode 100644 (file)
index 0000000..78b03cb
--- /dev/null
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+use strict; 
+use warnings;
+use Data::Dumper;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests=>5;
+
+#use_ok( 'MyTest' );
+#diag "Module::Pluggable::VERSION $Module::Pluggable::VERSION";
+
+my @plugins = MyTest->plugins;
+my @plugins_after;
+
+use_ok( 'MyTest::Plugin::Foo' );
+ok( my $foo = MyTest::Plugin::Foo->new() );
+
+@plugins_after = MyTest->plugins;
+is_deeply(
+    \@plugins_after,
+    \@plugins,
+    "plugins haven't been clobbered",
+);
+
+can_ok ($foo, 'frobnitz');
+
+@plugins_after = MyTest->plugins;
+is_deeply(
+    \@plugins_after,
+    \@plugins,
+    "plugins haven't been clobbered",
+) or diag Dumper ;
+
+
+
+package MyTest;
+
+use strict;
+use Module::Pluggable;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+1;
+
+
diff --git a/lib/Module/Pluggable/t/20dodgy_files.t b/lib/Module/Pluggable/t/20dodgy_files.t
new file mode 100644 (file)
index 0000000..3ad16d0
--- /dev/null
@@ -0,0 +1,67 @@
+#!perl -w
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 5;
+
+my $foo;
+ok($foo = OddTest->new());
+
+my @plugins;
+my @expected = ('OddTest::Plugin::-Dodgy', 'OddTest::Plugin::Foo');
+ok(@plugins = sort $foo->plugins);
+is_deeply(\@plugins, \@expected, "is deeply");
+
+my @odd_plugins;
+my @odd_expected = qw(OddTest::Plugin::Foo);
+ok(@odd_plugins = sort $foo->odd_plugins);
+is_deeply(\@odd_plugins, \@odd_expected, "is deeply");
+
+
+package OddTest::Pluggable;
+
+use Data::Dumper;
+use base qw(Module::Pluggable::Object);
+
+
+sub find_files { 
+    my $self = shift;
+    my @files = $self->SUPER::find_files(@_);
+    return grep { !/(^|\/)-/ } $self->SUPER::find_files(@_) ;
+}
+
+package OddTest;
+
+use strict;
+use Module::Pluggable;
+
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+
+}
+
+sub odd_plugins {
+    my $self = 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'} || "OddTest";
+    $opts{filename}  = $file;
+    $opts{package}   = $package;
+
+
+
+    my $op   = OddTest::Pluggable->new( package => ref($self) );
+    return $op->plugins(@_);
+    
+
+}
+
+
+1;
+
diff --git a/lib/Module/Pluggable/t/acme/Acme/MyTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/acme/Acme/MyTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..29c888b
--- /dev/null
@@ -0,0 +1,9 @@
+package Acme::MyTest::Plugin::Foo;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/Acme/MyTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/lib/Acme/MyTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..29c888b
--- /dev/null
@@ -0,0 +1,9 @@
+package Acme::MyTest::Plugin::Foo;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Bar.plugin b/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Bar.plugin
new file mode 100644 (file)
index 0000000..2f9b6db
--- /dev/null
@@ -0,0 +1,9 @@
+package MyTest::Plugin::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Foo.plugin b/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Foo.plugin
new file mode 100644 (file)
index 0000000..5386ba5
--- /dev/null
@@ -0,0 +1,9 @@
+package MyTest::Plugin::Foo;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Quux/Foo.plugin b/lib/Module/Pluggable/t/lib/ExtTest/Plugin/Quux/Foo.plugin
new file mode 100644 (file)
index 0000000..bb6e086
--- /dev/null
@@ -0,0 +1,9 @@
+package MyTest::Plugin::Quux::Foo;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/InnerTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/lib/InnerTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..4f5825e
--- /dev/null
@@ -0,0 +1,17 @@
+package InnerTest::Plugin::Foo;
+use strict;
+
+our $FOO = 1;
+
+package InnerTest::Plugin::Bar;
+use strict;
+
+sub bar {}
+
+package InnerTest::Plugin::Quux;
+use strict;
+use base qw(InnerTest::Plugin::Bar);
+
+
+
+1;
diff --git a/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Bar.pm b/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Bar.pm
new file mode 100644 (file)
index 0000000..3c5d79d
--- /dev/null
@@ -0,0 +1,5 @@
+package MyOtherTest::Plugin::Bar;
+use strict;
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..1482572
--- /dev/null
@@ -0,0 +1,5 @@
+package MyOtherTest::Plugin::Foo;
+use strict;
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux.pm b/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux.pm
new file mode 100644 (file)
index 0000000..22fd55d
--- /dev/null
@@ -0,0 +1,5 @@
+package MyOtherTest::Plugin::Quux;
+use strict;
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux/Foo.pm b/lib/Module/Pluggable/t/lib/MyOtherTest/Plugin/Quux/Foo.pm
new file mode 100644 (file)
index 0000000..a8ecd69
--- /dev/null
@@ -0,0 +1,5 @@
+package MyOtherTest::Plugin::Quux::Foo;
+use strict;
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyTest/Extend/Plugin/Bar.pm b/lib/Module/Pluggable/t/lib/MyTest/Extend/Plugin/Bar.pm
new file mode 100644 (file)
index 0000000..6d112cf
--- /dev/null
@@ -0,0 +1,17 @@
+package MyTest::Extend::Plugin::Bar;
+use strict;
+
+sub new {
+       my $class = shift;
+       my %self = @_;
+
+       return bless \%self, $class;
+}
+
+
+sub nork {
+       return $_[0]->{'nork'};
+}
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyTest/Plugin/Bar.pm b/lib/Module/Pluggable/t/lib/MyTest/Plugin/Bar.pm
new file mode 100644 (file)
index 0000000..2f9b6db
--- /dev/null
@@ -0,0 +1,9 @@
+package MyTest::Plugin::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/lib/MyTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..6ca8317
--- /dev/null
@@ -0,0 +1,10 @@
+package MyTest::Plugin::Foo;
+
+
+use strict;
+
+sub new { return bless {}, $_[0]; }
+sub frobnitz {}
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/MyTest/Plugin/Quux/Foo.pm b/lib/Module/Pluggable/t/lib/MyTest/Plugin/Quux/Foo.pm
new file mode 100644 (file)
index 0000000..bb6e086
--- /dev/null
@@ -0,0 +1,9 @@
+package MyTest::Plugin::Quux::Foo;
+
+
+use strict;
+
+
+1;
+
+
diff --git a/lib/Module/Pluggable/t/lib/No/Middle.pm b/lib/Module/Pluggable/t/lib/No/Middle.pm
new file mode 100644 (file)
index 0000000..9d0e31a
--- /dev/null
@@ -0,0 +1,14 @@
+package No::Middle;
+
+sub foo {}
+
+package No::Middle::Package::A;
+
+sub foo {}
+
+
+package No::Middle::Package::B;
+
+sub foo {}
+
+1;
diff --git a/lib/Module/Pluggable/t/lib/OddTest/Plugin/-Dodgy.pm b/lib/Module/Pluggable/t/lib/OddTest/Plugin/-Dodgy.pm
new file mode 100644 (file)
index 0000000..326e867
--- /dev/null
@@ -0,0 +1,5 @@
+package OddFiles::Plugin::Dodgy;
+
+sub new {}
+
+1;
diff --git a/lib/Module/Pluggable/t/lib/OddTest/Plugin/Foo.pm b/lib/Module/Pluggable/t/lib/OddTest/Plugin/Foo.pm
new file mode 100644 (file)
index 0000000..bcf37e3
--- /dev/null
@@ -0,0 +1,5 @@
+package OddFiles/Plugin/Foo.pm
+
+sub new {}
+
+1;
diff --git a/lib/Module/Pluggable/t/lib/TA/C/A/I.pm b/lib/Module/Pluggable/t/lib/TA/C/A/I.pm
new file mode 100644 (file)
index 0000000..35575df
--- /dev/null
@@ -0,0 +1,13 @@
+package TA::C::A::I;
+
+sub foo { }
+
+package TA::C::A::I::A;
+
+sub foo { }
+
+package TA::C::A::I::A::B;
+
+sub foo { }
+
+1;