This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Module-Pluggable-3.9
authorSteve Hay <SteveHay@planit.com>
Thu, 19 Mar 2009 15:41:52 +0000 (15:41 +0000)
committerSteve Hay <SteveHay@planit.com>
Thu, 19 Mar 2009 15:41:52 +0000 (15:41 +0000)
MANIFEST
ext/Module-Pluggable/Makefile.PL
ext/Module-Pluggable/lib/Module/Pluggable.pm
ext/Module-Pluggable/lib/Module/Pluggable/Object.pm
t/Module_Pluggable/10innerpack_onefile.t [new file with mode: 0644]
t/Module_Pluggable/12onlyrequire.t [new file with mode: 0644]
t/Module_Pluggable/lib/Acme/Foo-Bar.pm [new file with mode: 0644]
t/Module_Pluggable/lib/Zot/.Zork.pm [new file with mode: 0644]

index 7ed47df..e06597a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4023,12 +4023,14 @@ t/Module_Pluggable/08nothing.t  Module::Pluggable tests
 t/Module_Pluggable/09require.t Module::Pluggable tests
 t/Module_Pluggable/10innerpack_inner.t Module::Pluggable tests
 t/Module_Pluggable/10innerpack_noinner.t       Module::Pluggable tests
+t/Module_Pluggable/10innerpack_onefile.t       Module::Pluggable tests
 t/Module_Pluggable/10innerpack_override.t      Module::Pluggable tests
 t/Module_Pluggable/10innerpack_super.t         Module::Pluggable tests
 t/Module_Pluggable/10innerpack.t       Module::Pluggable tests
 t/Module_Pluggable/11usetwice.t        Module::Pluggable tests
 t/Module_Pluggable/12onlyarray.t       Module::Pluggable tests
 t/Module_Pluggable/12onlyregex.t       Module::Pluggable tests
+t/Module_Pluggable/12onlyrequire.t     Module::Pluggable tests
 t/Module_Pluggable/12only.t    Module::Pluggable tests
 t/Module_Pluggable/13exceptarray.t     Module::Pluggable tests
 t/Module_Pluggable/13exceptregex.t     Module::Pluggable tests
@@ -4042,6 +4044,7 @@ t/Module_Pluggable/19can_ok_clobber.t     Module::Pluggable tests
 t/Module_Pluggable/20dodgy_files.t     Module::Pluggable tests
 t/Module_Pluggable/21editor_junk.t                     Module::Pluggable tests
 t/Module_Pluggable/acme/Acme/MyTest/Plugin/Foo.pm      Module::Pluggable tests
+t/Module_Pluggable/lib/Acme/Foo-Bar.pm                 Module::Pluggable tests
 t/Module_Pluggable/lib/Acme/MyTest/Plugin/Foo.pm       Module::Pluggable tests
 t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm                Module::Pluggable tests
 t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~       Module::Pluggable tests
@@ -4063,6 +4066,7 @@ t/Module_Pluggable/lib/MyTest/Plugin/Quux/Foo.pm  Module::Pluggable tests
 t/Module_Pluggable/lib/No/Middle.pm    Module::Pluggable tests
 t/Module_Pluggable/lib/OddTest/Plugin/Foo.pm   Module::Pluggable tests
 t/Module_Pluggable/lib/TA/C/A/I.pm     Module::Pluggable tests
+t/Module_Pluggable/lib/Zot/.Zork.pm    Module::Pluggable tests
 t/mro/basic_01_c3.t            mro tests
 t/mro/basic_01_dfs.t           mro tests
 t/mro/basic_02_c3.t            mro tests
index c926c54..8509813 100644 (file)
@@ -17,13 +17,13 @@ my @path = $core ? (File::Spec->updir, File::Spec->updir, File::Spec->updir,
                    "t", "Module_Pluggable") : ($FindBin::Bin,"t");
 
 my @files;
-if ($^O ne 'VMS' && $^O ne 'VOS') {
+unless (grep { lc($^O) eq $_ } qw(vms vos)) {
     foreach my $test (keys %dodgy_files) {
         my ($file) = (catfile(@path, "lib", $test)=~/^(.*)$/);
-        if (open(my $fh, ">", $file)) {
+        if (open(FH, ">$file")) {
             my $name = $dodgy_files{$test};
-            print $fh "package $name;\nsub new {}\n1;";
-            close($fh);
+            print FH "package $name;\nsub new {}\n1;";
+            close(FH);
             push @files, $file;
         }
     }
@@ -41,6 +41,7 @@ WriteMakefile
                          },
           'EXE_FILES'    => [],
           'INSTALLDIRS'  => ($] >= 5.008009) ? "perl" : "site",
+          'INST_LIB'     => ($] >= 5.008009) ? 'blib/arch' : 'blib/lib',
           'PL_FILES'     => {},
           'realclean'    => {FILES=> join ' ', @files},
           # In the core pods will be built by installman.
index 7de3033..bbdb49b 100644 (file)
@@ -9,7 +9,7 @@ use Module::Pluggable::Object;
 # Peter Gibbons: I wouldn't say I've been missing it, Bob! 
 
 
-$VERSION = '3.8';
+$VERSION = '3.9';
 
 sub import {
     my $class        = shift;
index d99eb9d..e0ee993 100644 (file)
@@ -6,10 +6,9 @@ use File::Basename;
 use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel);
 use Carp qw(croak carp);
 use Devel::InnerPackage;
-use Data::Dumper;
 use vars qw($VERSION);
 
-$VERSION = '3.6';
+$VERSION = '3.9';
 
 
 sub new {
@@ -34,14 +33,14 @@ sub plugins {
         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'}; 
 
@@ -57,6 +56,7 @@ sub plugins {
 
 
         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'}});
         
@@ -64,43 +64,12 @@ sub plugins {
         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! );
+            next unless $self->_is_legit($_);
             $plugins{$_} = 1;
         }
 
@@ -116,6 +85,58 @@ sub 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 = @_;
@@ -125,7 +146,6 @@ sub search_directories {
     foreach my $dir (@SEARCHDIR) {
         push @plugins, $self->search_paths($dir);
     }
-
     return @plugins;
 }
 
@@ -209,7 +229,7 @@ sub search_paths {
         # 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});
+        push @plugins, $self->handle_innerpackages($searchpath);
     } # foreach $searchpath
 
     return @plugins;
@@ -236,6 +256,7 @@ sub handle_finding_plugin {
     my $plugin = shift;
 
     return unless (defined $self->{'instantiate'} || $self->{'require'}); 
+    return unless $self->_is_legit($plugin);
     $self->_require($plugin);
 }
 
@@ -267,10 +288,11 @@ sub find_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;
diff --git a/t/Module_Pluggable/10innerpack_onefile.t b/t/Module_Pluggable/10innerpack_onefile.t
new file mode 100644 (file)
index 0000000..01caf37
--- /dev/null
@@ -0,0 +1,27 @@
+#!perl -wT
+
+use strict;
+use Test::More tests => 2;
+use Data::Dumper;
+
+my $mc  = MyClass->new();
+my $mc2 = MyClass2->new();
+
+
+is_deeply([$mc->plugins],  [qw(MyClass::Plugin::MyPlugin)], "Got inner plugin");
+is_deeply([$mc2->plugins], [],                              "Didn't get plugin");
+
+package MyClass::Plugin::MyPlugin;
+sub pretty { print "I am pretty" };
+
+package MyClass;
+use Module::Pluggable inner => 1;
+
+sub new { return bless {}, $_[0] }
+
+package MyClass2;
+use Module::Pluggable search_path => "MyClass::Plugin", inner => 0;
+
+sub new { return bless {}, $_[0] }
+1;
+
diff --git a/t/Module_Pluggable/12onlyrequire.t b/t/Module_Pluggable/12onlyrequire.t
new file mode 100644 (file)
index 0000000..cf76b4d
--- /dev/null
@@ -0,0 +1,21 @@
+#!perl -w
+use strict;
+use FindBin;
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
+use Test::More tests => 2;
+
+my @packages = eval { Zot->_dist_types };
+is($@, '',                "No warnings");
+is(scalar(@packages), 0,  "Correctly only got 1 package");
+
+
+package Zot;
+use strict;
+use Module::Pluggable (
+        sub_name => '_dist_types',
+        search_path => __PACKAGE__,
+        only => qr/Zot::\w+$/,
+        require => 1,
+    );
+
+1;
diff --git a/t/Module_Pluggable/lib/Acme/Foo-Bar.pm b/t/Module_Pluggable/lib/Acme/Foo-Bar.pm
new file mode 100644 (file)
index 0000000..4fc48c6
--- /dev/null
@@ -0,0 +1,6 @@
+package Acme::FooBar;
+
+our $quux = "hello";
+
+1;
+
diff --git a/t/Module_Pluggable/lib/Zot/.Zork.pm b/t/Module_Pluggable/lib/Zot/.Zork.pm
new file mode 100644 (file)
index 0000000..e69de29