r2902 - in
/packages/libmodule-pluggable-perl/branches/upstream/current: ./
lib/Devel/ lib/Module/ lib/Module/Pluggable/ t/ t/lib/ExtTest/
t/lib/ExtTest/Plugin/ t/lib/ExtTest/Plugin/Quux/ t/lib/TA/ t/lib/TA/C/
t/lib/TA/C/A/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Wed Jun 7 13:09:20 UTC 2006
Author: eloy
Date: Wed Jun 7 13:09:19 2006
New Revision: 2902
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2902
Log:
Load /tmp/tmp.bhHoD14024/libmodule-pluggable-perl-3.01 into
packages/libmodule-pluggable-perl/branches/upstream/current.
Added:
packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/
packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/InnerPackage.pm
packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/
packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/Object.pm
packages/libmodule-pluggable-perl/branches/upstream/current/t/16different_extension.t
packages/libmodule-pluggable-perl/branches/upstream/current/t/17devel_inner_package.t
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Bar.plugin
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Foo.plugin
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/Foo.plugin
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/
packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/I.pm
Modified:
packages/libmodule-pluggable-perl/branches/upstream/current/Changes
packages/libmodule-pluggable-perl/branches/upstream/current/MANIFEST
packages/libmodule-pluggable-perl/branches/upstream/current/META.yml
packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable.pm
packages/libmodule-pluggable-perl/branches/upstream/current/t/01use.t
Modified: packages/libmodule-pluggable-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/Changes?rev=2902&op=diff
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/Changes (original)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/Changes Wed Jun 7 13:09:19 2006
@@ -1,3 +1,13 @@
+2006-06-07 - 3.01
+ Fix from Brian Cassidy in Devel::InnerPackage
+
+2006-06-06 - 3.0
+ Big refactor to split stuff up into more manageable pieces
+
+
+2006-04-05 - 2.98
+ Allow the ability to provide the file matching regex
+
2006-02-06 - 2.97
Patch from Ricardo Signes to fix bug where File::Find
is not topic-safe in 5.6.1
Modified: packages/libmodule-pluggable-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/MANIFEST?rev=2902&op=diff
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/MANIFEST Wed Jun 7 13:09:19 2006
@@ -6,7 +6,9 @@
META.yml
Makefile.PL
README
+lib/Devel/InnerPackage.pm
lib/Module/Pluggable.pm
+lib/Module/Pluggable/Object.pm
t/01use.t
t/02alsoworks.t
t/02works.t
@@ -33,8 +35,13 @@
t/13exceptregex.t
t/14package.t
t/15topicsafe.t
+t/16different_extension.t
+t/17devel_inner_package.t
t/acme/Acme/MyTest/Plugin/Foo.pm
t/lib/Acme/MyTest/Plugin/Foo.pm
+t/lib/ExtTest/Plugin/Bar.plugin
+t/lib/ExtTest/Plugin/Foo.plugin
+t/lib/ExtTest/Plugin/Quux/Foo.plugin
t/lib/MyTest/Extend/Plugin/Bar.pm
t/lib/MyTest/Plugin/Bar.pm
t/lib/MyTest/Plugin/Foo.pm
@@ -45,5 +52,6 @@
t/lib/MyOtherTest/Plugin/Quux/Foo.pm
t/lib/InnerTest/Plugin/Foo.pm
t/plugins/test.plugin
+t/lib/TA/C/A/I.pm
Modified: packages/libmodule-pluggable-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/META.yml?rev=2902&op=diff
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/META.yml (original)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/META.yml Wed Jun 7 13:09:19 2006
@@ -1,6 +1,6 @@
---
name: Module-Pluggable
-version: 2.97
+version: 3.01
author:
- Simon Wistow <simon at thegestalt.org>
abstract: automatically give your module the ability to have plugins
@@ -10,7 +10,12 @@
File::Spec::Functions: 0
Test::More: 0
provides:
+ Devel::InnerPackage:
+ file: lib/Devel/InnerPackage.pm
+ version: 0.2
Module::Pluggable:
file: lib/Module/Pluggable.pm
- version: 2.97
+ version: 3.01
+ Module::Pluggable::Object:
+ file: lib/Module/Pluggable/Object.pm
generated_by: Module::Build version 0.2611
Added: packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/InnerPackage.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/InnerPackage.pm?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/InnerPackage.pm (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/lib/Devel/InnerPackage.pm Wed Jun 7 13:09:19 2006
@@ -1,0 +1,100 @@
+package Devel::InnerPackage;
+
+use strict;
+use base qw(Exporter);
+use vars qw($VERSION @EXPORT_OK);
+
+
+
+$VERSION = '0.2';
+ at EXPORT_OK = qw(list_packages);
+
+=pod
+
+=head1 NAME
+
+
+Devel::InnerPackage - find all the inner packages of a package
+
+=head1 SYNOPSIS
+
+ use Foo::Bar;
+ use Devel::innerPackages qw(list_packages);
+
+ my @inner_packages = list_packages('Foo::Bar');
+
+
+=head1 DESCRIPTION
+
+
+Given a file like this
+
+
+ package Foo::Bar;
+
+ sub foo {}
+
+
+ package Foo::Bar::Quux;
+
+ sub quux {}
+
+ package Foo::Bar::Quirka;
+
+ sub quirka {}
+
+ 1;
+
+then
+
+ list_packages('Foo::Bar');
+
+will return
+
+ Foo::Bar::Quux
+ Foo::Bar::Quirka
+
+=head1 METHODS
+
+=head2 list_packages <package name>
+
+Return a list of all inner packages of that package.
+
+=cut
+
+sub list_packages {
+ my $pack = shift; $pack .= "::" unless $pack =~ m!::$!;
+
+ no strict 'refs';
+ my @packs;
+ for (grep !/^(main|)::$/, grep /::$/, keys %{$pack})
+ {
+ s!::$!!;
+ my @children = list_packages($pack.$_);
+ push @packs, "$pack$_" unless /^::/;
+ push @packs, @children;
+ }
+ return grep {$_ !~ /::::ISA::CACHE/} @packs;
+}
+
+=head1 AUTHOR
+
+Simon Wistow <simon at thegestalt.org>
+
+=head1 COPYING
+
+Copyright, 2005 Simon Wistow
+
+Distributed under the same terms as Perl itself.
+
+=head1 BUGS
+
+None known.
+
+=cut
+
+
+
+
+
+1;
Modified: packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable.pm?rev=2902&op=diff
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable.pm (original)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable.pm Wed Jun 7 13:09:19 2006
@@ -2,18 +2,73 @@
use strict;
use vars qw($VERSION);
-use File::Find ();
-use File::Basename;
-use File::Spec::Functions qw(splitdir catdir abs2rel);
-use Carp qw(croak carp);
-
+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 = '2.97';
+$VERSION = '3.01';
+
+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, at 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
@@ -234,6 +289,16 @@
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
@@ -264,7 +329,7 @@
=head1 COPYING
-Copyright, 2003 Simon Wistow
+Copyright, 2006 Simon Wistow
Distributed under the same terms as Perl itself.
@@ -279,236 +344,3 @@
=cut
-sub import {
- my $class = shift;
- my %opts = @_;
-
- # override 'require'
- $opts{'require'} = 1 if $opts{'inner'};
-
- if ($opts{'par'}) {
-
- }
-
- my ($package, $filename) = caller;
-
- # automatically turn a scalar search path or namespace into a arrayref
- for (qw(search_path search_dirs)) {
- $opts{$_} = [ $opts{$_} ] if exists $opts{$_} && !ref($opts{$_});
- }
-
-
- # the default name for the method is 'plugins'
- my $sub = $opts{'sub_name'} || 'plugins';
-
-
- # get our package
- my ($pkg) = $opts{'package'} || $package;
-
- my $subroutine = sub {
- my $self = shift;
-
-
- # default search path is '<Module>::<Name>::Plugin'
- $opts{'search_path'} = ["${pkg}::Plugin"] unless $opts{'search_path'};
-
- # predeclare
- my @plugins;
-
-
- # 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, @{$opts{'search_dirs'}} if defined $opts{'search_dirs'};
-
-
- # go through our @INC
- foreach my $dir (@SEARCHDIR) {
-
- # and each directory in our search path
- foreach my $searchpath (@{$opts{'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
-
-
- # 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 =~ /\.pm$/;
- (my $path = $File::Find::name) =~ s#^\\./##;
- push @files, $path;
- }},
- $sp );
- }
- #chdir $cwd;
-
- # foreach one we've found
- foreach my $file (@files) {
- # untaint the file; accept .pm only
- next unless ($file) = ($file =~ /(.*\.pm)$/);
- # parse the file to get the name
- my ($name, $directory) = fileparse($file, qr{\.pm$});
- $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);
- if (defined $opts{'instantiate'} || $opts{'require'}) {
-
- eval "CORE::require $plugin";
- carp "Couldn't require $plugin : $@" if $@;
- }
- 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 :(
- unless (exists $opts{inner} && !$opts{inner}) {
- for (list_packages($searchpath)) {
- if (defined $opts{'instantiate'} || $opts{'require'}) {
- eval "CORE::require $_";
- # *No warnings here*
- # next if $@;
- }
- push @plugins, $_;
- } # for list packages
- } # unless inner
- } # foreach $searchpath
- } # foreach $dir
-
-
-
-
- # push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$opts{'search_path'}});
-
- # return blank unless we've found anything
- return () unless @plugins;
-
-
- # exceptions
- my %only;
- my %except;
- my $only;
- my $except;
-
- if (defined $opts{'only'}) {
- if (ref($opts{'only'}) eq 'ARRAY') {
- %only = map { $_ => 1 } @{$opts{'only'}};
- } elsif (ref($opts{'only'}) eq 'Regexp') {
- $only = $opts{'only'}
- } elsif (ref($opts{'only'}) eq '') {
- $only{$opts{'only'}} = 1;
- }
- }
-
-
- if (defined $opts{'except'}) {
- if (ref($opts{'except'}) eq 'ARRAY') {
- %except = map { $_ => 1 } @{$opts{'except'}};
- } elsif (ref($opts{'except'}) eq 'Regexp') {
- $except = $opts{'except'}
- } elsif (ref($opts{'except'}) eq '') {
- $except{$opts{'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 $opts{'instantiate'}) {
- my $method = $opts{'instantiate'};
- return map { ($_->can($method)) ? $_->$method(@_) : () } keys %plugins;
- } else {
- # no? just return the names
- return keys %plugins;
- }
-
-
- };
-
-
- my $searchsub = sub {
- my $self = shift;
- my ($action, at paths) = @_;
-
- $opts{'search_path'} = ["${pkg}::Plugin"] if ($action eq 'add' and not $opts{'search_path'} );;
- push @{$opts{'search_path'}}, @paths if ($action eq 'add');
- $opts{'search_path'} = \@paths if ($action eq 'new');
- return $opts{'search_path'};
- };
-
- my $onlysub = sub {
- my ($self, $only) = @_;
-
- if (defined $only) {
- $opts{'only'} = $only;
- };
-
- return $opts{'only'};
- };
-
- my $exceptsub = sub {
- my ($self, $except) = @_;
-
- if (defined $except) {
- $opts{'except'} = $except;
- };
-
- return $opts{'except'};
- };
-
- no strict 'refs';
- no warnings 'redefine';
- *{"$pkg\::$sub"} = $subroutine;
- *{"$pkg\::search_path"} = $searchsub;
- *{"$pkg\::only"} = $onlysub;
- *{"$pkg\::except"} = $exceptsub;
-}
-
-
-sub list_packages {
- my $pack = shift; $pack .= "::" unless $pack =~ m!::$!;
-
- no strict 'refs';
- my @packs;
- for (grep !/^(main|)::$/, grep /::$/, keys %{$pack})
- {
- s!::$!!;
- my @children = list_packages($pack.$_);
- push @packs, "$pack$_" unless @children or /^::/;
- push @packs, @children;
- }
- return grep {$_ !~ /::::ISA::CACHE/} @packs;
-}
-
-
-1;
Added: packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/Object.pm?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/Object.pm (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/lib/Module/Pluggable/Object.pm Wed Jun 7 13:09:19 2006
@@ -1,0 +1,283 @@
+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;
+
+ eval { $self->handle_finding_plugin($plugin) };
+ carp "Couldn't require $plugin : $@" if $@;
+
+ 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)) {
+ eval { $self->handle_finding_plugin($plugin) };
+ # next if $@;
+ 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 at 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
+
Modified: packages/libmodule-pluggable-perl/branches/upstream/current/t/01use.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/01use.t?rev=2902&op=diff
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/01use.t (original)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/01use.t Wed Jun 7 13:09:19 2006
@@ -1,7 +1,9 @@
#!perl -wT
use strict;
-use Test::More tests => 1;
+use Test::More tests => 3;
use_ok('Module::Pluggable');
+use_ok('Module::Pluggable::Object');
+use_ok('Devel::InnerPackage');
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/16different_extension.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/16different_extension.t?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/16different_extension.t (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/16different_extension.t Wed Jun 7 13:09:19 2006
@@ -1,0 +1,41 @@
+#!perl -wT
+
+use strict;
+use lib 't/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");
+
+ at 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;
+
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/17devel_inner_package.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/17devel_inner_package.t?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/17devel_inner_package.t (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/17devel_inner_package.t Wed Jun 7 13:09:19 2006
@@ -1,0 +1,12 @@
+use Test::More tests => 3;
+
+use Devel::InnerPackage qw(list_packages);
+use lib qw(t/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)]);
+
+
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Bar.plugin
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Bar.plugin?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Bar.plugin (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Bar.plugin Wed Jun 7 13:09:19 2006
@@ -1,0 +1,9 @@
+package MyTest::Plugin::Bar;
+
+
+use strict;
+
+
+1;
+
+
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Foo.plugin
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Foo.plugin?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Foo.plugin (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Foo.plugin Wed Jun 7 13:09:19 2006
@@ -1,0 +1,9 @@
+package MyTest::Plugin::Foo;
+
+
+use strict;
+
+
+1;
+
+
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/Foo.plugin
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/Foo.plugin?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/Foo.plugin (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/ExtTest/Plugin/Quux/Foo.plugin Wed Jun 7 13:09:19 2006
@@ -1,0 +1,9 @@
+package MyTest::Plugin::Quux::Foo;
+
+
+use strict;
+
+
+1;
+
+
Added: packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/I.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/I.pm?rev=2902&op=file
==============================================================================
--- packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/I.pm (added)
+++ packages/libmodule-pluggable-perl/branches/upstream/current/t/lib/TA/C/A/I.pm Wed Jun 7 13:09:19 2006
@@ -1,0 +1,7 @@
+package TA::C::A::I;
+
+package TA::C::A::I::A;
+
+package TA::C::A::I::A::B;
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list