1 package Module::Pluggable::Object;
6 use File::Spec::Functions qw(splitdir catdir abs2rel);
7 use Carp qw(croak carp);
8 use Devel::InnerPackage;
15 return bless \%opts, $class;
24 $self->{'require'} = 1 if $self->{'inner'};
26 my $filename = $self->{'filename'};
27 my $pkg = $self->{'package'};
29 # automatically turn a scalar search path or namespace into a arrayref
30 for (qw(search_path search_dirs)) {
31 $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_});
37 # default search path is '<Module>::<Name>::Plugin'
38 $self->{'search_path'} = ["${pkg}::Plugin"] unless $self->{'search_path'};
44 # check to see if we're running under test
45 my @SEARCHDIR = exists $INC{"blib.pm"} && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC;
47 # add any search_dir params
48 unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'};
51 my @plugins = $self->search_directories(@SEARCHDIR);
53 # push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$self->{'search_path'}});
55 # return blank unless we've found anything
56 return () unless @plugins;
65 if (defined $self->{'only'}) {
66 if (ref($self->{'only'}) eq 'ARRAY') {
67 %only = map { $_ => 1 } @{$self->{'only'}};
68 } elsif (ref($self->{'only'}) eq 'Regexp') {
69 $only = $self->{'only'}
70 } elsif (ref($self->{'only'}) eq '') {
71 $only{$self->{'only'}} = 1;
76 if (defined $self->{'except'}) {
77 if (ref($self->{'except'}) eq 'ARRAY') {
78 %except = map { $_ => 1 } @{$self->{'except'}};
79 } elsif (ref($self->{'except'}) eq 'Regexp') {
80 $except = $self->{'except'}
81 } elsif (ref($self->{'except'}) eq '') {
82 $except{$self->{'except'}} = 1;
88 # probably not necessary but hey ho
91 next if (keys %only && !$only{$_} );
92 next unless (!defined $only || m!$only! );
94 next if (keys %except && $except{$_} );
95 next if (defined $except && m!$except! );
99 # are we instantiating or requring?
100 if (defined $self->{'instantiate'}) {
101 my $method = $self->{'instantiate'};
102 return map { ($_->can($method)) ? $_->$method(@_) : () } keys %plugins;
104 # no? just return the names
105 return keys %plugins;
111 sub search_directories {
116 # go through our @INC
117 foreach my $dir (@SEARCHDIR) {
118 push @plugins, $self->search_paths($dir);
130 my $file_regex = $self->{'file_regex'} || qr/\.pm$/;
133 # and each directory in our search path
134 foreach my $searchpath (@{$self->{'search_path'}}) {
135 # create the search directory in a cross platform goodness way
136 my $sp = catdir($dir, (split /::/, $searchpath));
138 # if it doesn't exist or it's not a dir then skip it
139 next unless ( -e $sp && -d _ ); # Use the cached stat the second time
141 my @files = $self->find_files($sp);
143 # foreach one we've found
144 foreach my $file (@files) {
145 # untaint the file; accept .pm only
146 next unless ($file) = ($file =~ /(.*$file_regex)$/);
147 # parse the file to get the name
148 my ($name, $directory) = fileparse($file, $file_regex);
150 $directory = abs2rel($directory, $sp);
151 # then create the class name in a cross platform way
152 $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); # remove volume
154 ($directory) = ($directory =~ /(.*)/);
158 my $plugin = join "::", splitdir catdir($searchpath, $directory, $name);
160 next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i;
162 my $err = eval { $self->handle_finding_plugin($plugin) };
163 carp "Couldn't require $plugin : $err" if $err;
165 push @plugins, $plugin;
168 # now add stuff that may have been in package
169 # NOTE we should probably use all the stuff we've been given already
170 # but then we can't unload it :(
171 push @plugins, $self->handle_innerpackages($searchpath) unless (exists $self->{inner} && !$self->{inner});
172 } # foreach $searchpath
177 sub handle_finding_plugin {
181 return unless (defined $self->{'instantiate'} || $self->{'require'});
182 $self->_require($plugin);
187 my $search_path = shift;
188 my $file_regex = $self->{'file_regex'} || qr/\.pm$/;
191 # find all the .pm files in it
192 # this isn't perfect and won't find multiple plugins per file
193 #my $cwd = Cwd::getcwd;
195 { # for the benefit of perl 5.6.1's Find, localize topic
197 File::Find::find( { no_chdir => 1,
199 # Inlined from File::Find::Rule C< name => '*.pm' >
200 return unless $File::Find::name =~ /$file_regex/;
201 (my $path = $File::Find::name) =~ s#^\\./##;
211 sub handle_innerpackages {
217 foreach my $plugin (Devel::InnerPackage::list_packages($path)) {
218 my $err = eval { $self->handle_finding_plugin($plugin) };
220 #next unless $INC{$plugin};
221 push @plugins, $plugin;
231 eval "CORE::require $pack";
242 Module::Pluggable::Object - automatically give your module the ability to have plugins
247 Simple use Module::Pluggable -
250 use Module::Pluggable::Object;
252 my $finder = Module::Pluggable::Object->new(%opts);
253 print "My plugins are: ".join(", ", $finder->plugins)."\n";
257 Provides a simple but, hopefully, extensible way of having 'plugins' for
258 your module. Obviously this isn't going to be the be all and end all of
259 solutions but it works for me.
261 Essentially all it does is export a method into your namespace that
262 looks through a search path for .pm files and turn those into class names.
264 Optionally it instantiates those classes for you.
268 Simon Wistow <simon@thegestalt.org>
272 Copyright, 2006 Simon Wistow
274 Distributed under the same terms as Perl itself.