From: Steve Hay Date: Thu, 19 Mar 2009 15:41:52 +0000 (+0000) Subject: Upgrade to Module-Pluggable-3.9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0df7637f63b4239ab2bce3bc377d52a3e09cb02;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Module-Pluggable-3.9 --- diff --git a/MANIFEST b/MANIFEST index 7ed47df..e06597a 100644 --- 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 diff --git a/ext/Module-Pluggable/Makefile.PL b/ext/Module-Pluggable/Makefile.PL index c926c54..8509813 100644 --- a/ext/Module-Pluggable/Makefile.PL +++ b/ext/Module-Pluggable/Makefile.PL @@ -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. diff --git a/ext/Module-Pluggable/lib/Module/Pluggable.pm b/ext/Module-Pluggable/lib/Module/Pluggable.pm index 7de3033..bbdb49b 100644 --- a/ext/Module-Pluggable/lib/Module/Pluggable.pm +++ b/ext/Module-Pluggable/lib/Module/Pluggable.pm @@ -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; diff --git a/ext/Module-Pluggable/lib/Module/Pluggable/Object.pm b/ext/Module-Pluggable/lib/Module/Pluggable/Object.pm index d99eb9d..e0ee993 100644 --- a/ext/Module-Pluggable/lib/Module/Pluggable/Object.pm +++ b/ext/Module-Pluggable/lib/Module/Pluggable/Object.pm @@ -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 '::::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 index 0000000..01caf37 --- /dev/null +++ b/t/Module_Pluggable/10innerpack_onefile.t @@ -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 index 0000000..cf76b4d --- /dev/null +++ b/t/Module_Pluggable/12onlyrequire.t @@ -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 index 0000000..4fc48c6 --- /dev/null +++ b/t/Module_Pluggable/lib/Acme/Foo-Bar.pm @@ -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 index 0000000..e69de29