vcs.maemo.org Git - pkg-perl/blob - deb-src/libmodule-pluggable-perl/libmodule-pluggable-perl-3.8/lib/Module/Pluggable.pm

   1 package Module::Pluggable;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 use Module::Pluggable::Object;
   6
   7 # ObQuote:
   8 # Bob Porter: Looks like you've been missing a lot of work lately.
   9 # Peter Gibbons: I wouldn't say I've been missing it, Bob!
  10
  11
  12 $VERSION = '3.8';
  13
  14 sub import {
  15     my $class        = shift;
  16     my %opts         = @_;
  17
  18     my ($pkg, $file) = caller;
  19     # the default name for the method is 'plugins'
  20     my $sub          = $opts{'sub_name'}  || 'plugins';
  21     # get our package
  22     my ($package)    = $opts{'package'} || $pkg;
  23     $opts{filename}  = $file;
  24     $opts{package}   = $package;
  25
  26
  27     my $finder       = Module::Pluggable::Object->new(%opts);
  28     my $subroutine   = sub { my $self = shift; return $finder->plugins(@_) };
  29
  30     my $searchsub = sub {
  31               my $self = shift;
  32               my ($action,@paths) = @_;
  33
  34               $finder->{'search_path'} = ["${package}::Plugin"] if ($action eq 'add'  and not   $finder->{'search_path'} );
  35               push @{$finder->{'search_path'}}, @paths      if ($action eq 'add');
  36               $finder->{'search_path'}       = \@paths      if ($action eq 'new');
  37               return $finder->{'search_path'};
  38     };
  39
  40
  41     my $onlysub = sub {
  42         my ($self, $only) = @_;
  43
  44         if (defined $only) {
  45             $finder->{'only'} = $only;
  46         };
  47
  48         return $finder->{'only'};
  49     };
  50
  51     my $exceptsub = sub {
  52         my ($self, $except) = @_;
  53
  54         if (defined $except) {
  55             $finder->{'except'} = $except;
  56         };
  57
  58         return $finder->{'except'};
  59     };
  60
  61
  62     no strict 'refs';
  63     no warnings qw(redefine prototype);
  64
  65     *{"$package\::$sub"}        = $subroutine;
  66     *{"$package\::search_path"} = $searchsub;
  67     *{"$package\::only"}        = $onlysub;
  68     *{"$package\::except"}      = $exceptsub;
  69
  70 }
  71
  72 1;
  73
  74 =pod
  75
  76 =head1 NAME
  77
  78 Module::Pluggable - automatically give your module the ability to have plugins
  79
  80 =head1 SYNOPSIS
  81
  82
  83 Simple use Module::Pluggable -
  84
  85     package MyClass;
  86     use Module::Pluggable;
  87
  88
  89 and then later ...
  90
  91     use MyClass;
  92     my $mc = MyClass->new();
  93     # returns the names of all plugins installed under MyClass::Plugin::*
  94     my @plugins = $mc->plugins();
  95
  96 =head1 EXAMPLE
  97
  98 Why would you want to do this? Say you have something that wants to pass an
  99 object to a number of different plugins in turn. For example you may
 100 want to extract meta-data from every email you get sent and do something
 101 with it. Plugins make sense here because then you can keep adding new
 102 meta data parsers and all the logic and docs for each one will be
 103 self contained and new handlers are easy to add without changing the
 104 core code. For that, you might do something like ...
 105
 106     package Email::Examiner;
 107
 108     use strict;
 109     use Email::Simple;
 110     use Module::Pluggable require => 1;
 111
 112     sub handle_email {
 113         my $self  = shift;
 114         my $email = shift;
 115
 116         foreach my $plugin ($self->plugins) {
 117             $plugin->examine($email);
 118         }
 119
 120         return 1;
 121     }
 122
 123
 124
 125 .. and all the plugins will get a chance in turn to look at it.
 126
 127 This can be trivally extended so that plugins could save the email
 128 somewhere and then no other plugin should try and do that.
 129 Simply have it so that the C<examine> method returns C<1> if
 130 it has saved the email somewhere. You might also wnat to be paranoid
 131 and check to see if the plugin has an C<examine> method.
 132
 133         foreach my $plugin ($self->plugins) {
 134             next unless $plugin->can('examine');
 135             last if     $plugin->examine($email);
 136         }
 137
 138
 139 And so on. The sky's the limit.
 140
 141
 142 =head1 DESCRIPTION
 143
 144 Provides a simple but, hopefully, extensible way of having 'plugins' for
 145 your module. Obviously this isn't going to be the be all and end all of
 146 solutions but it works for me.
 147
 148 Essentially all it does is export a method into your namespace that
 149 looks through a search path for .pm files and turn those into class names.
 150
 151 Optionally it instantiates those classes for you.
 152
 153 =head1 ADVANCED USAGE
 154
 155
 156 Alternatively, if you don't want to use 'plugins' as the method ...
 157
 158     package MyClass;
 159     use Module::Pluggable sub_name => 'foo';
 160
 161
 162 and then later ...
 163
 164     my @plugins = $mc->foo();
 165
 166
 167 Or if you want to look in another namespace
 168
 169     package MyClass;
 170     use Module::Pluggable search_path => ['Acme::MyClass::Plugin', 'MyClass::Extend'];
 171
 172 or directory
 173
 174     use Module::Pluggable search_dirs => ['mylibs/Foo'];
 175
 176
 177 Or if you want to instantiate each plugin rather than just return the name
 178
 179     package MyClass;
 180     use Module::Pluggable instantiate => 'new';
 181
 182 and then
 183
 184     # whatever is passed to 'plugins' will be passed
 185     # to 'new' for each plugin
 186     my @plugins = $mc->plugins(@options);
 187
 188
 189 alternatively you can just require the module without instantiating it
 190
 191     package MyClass;
 192     use Module::Pluggable require => 1;
 193
 194 since requiring automatically searches inner packages, which may not be desirable, you can turn this off
 195
 196
 197     package MyClass;
 198     use Module::Pluggable require => 1, inner => 0;
 199
 200
 201 You can limit the plugins loaded using the except option, either as a string,
 202 array ref or regex
 203
 204     package MyClass;
 205     use Module::Pluggable except => 'MyClass::Plugin::Foo';
 206
 207 or
 208
 209     package MyClass;
 210     use Module::Pluggable except => ['MyClass::Plugin::Foo', 'MyClass::Plugin::Bar'];
 211
 212 or
 213
 214     package MyClass;
 215     use Module::Pluggable except => qr/^MyClass::Plugin::(Foo|Bar)$/;
 216
 217
 218 and similarly for only which will only load plugins which match.
 219
 220 Remember you can use the module more than once
 221
 222     package MyClass;
 223     use Module::Pluggable search_path => 'MyClass::Filters' sub_name => 'filters';
 224     use Module::Pluggable search_path => 'MyClass::Plugins' sub_name => 'plugins';
 225
 226 and then later ...
 227
 228     my @filters = $self->filters;
 229     my @plugins = $self->plugins;
 230
 231 =head1 INNER PACKAGES
 232
 233 If you have, for example, a file B<lib/Something/Plugin/Foo.pm> that
 234 contains package definitions for both C<Something::Plugin::Foo> and
 235 C<Something::Plugin::Bar> then as long as you either have either
 236 the B<require> or B<instantiate> option set then we'll also find
 237 C<Something::Plugin::Bar>. Nifty!
 238
 239 =head1 OPTIONS
 240
 241 You can pass a hash of options when importing this module.
 242
 243 The options can be ...
 244
 245 =head2 sub_name
 246
 247 The name of the subroutine to create in your namespace.
 248
 249 By default this is 'plugins'
 250
 251 =head2 search_path
 252
 253 An array ref of namespaces to look in.
 254
 255 =head2 search_dirs
 256
 257 An array ref of directorys to look in before @INC.
 258
 259 =head2 instantiate
 260
 261 Call this method on the class. In general this will probably be 'new'
 262 but it can be whatever you want. Whatever arguments are passed to 'plugins'
 263 will be passed to the method.
 264
 265 The default is 'undef' i.e just return the class name.
 266
 267 =head2 require
 268
 269 Just require the class, don't instantiate (overrides 'instantiate');
 270
 271 =head2 inner
 272
 273 If set to 0 will B<not> search inner packages.
 274 If set to 1 will override C<require>.
 275
 276 =head2 only
 277
 278 Takes a string, array ref or regex describing the names of the only plugins to
 279 return. Whilst this may seem perverse ... well, it is. But it also
 280 makes sense. Trust me.
 281
 282 =head2 except
 283
 284 Similar to C<only> it takes a description of plugins to exclude
 285 from returning. This is slightly less perverse.
 286
 287 =head2 package
 288
 289 This is for use by extension modules which build on C<Module::Pluggable>:
 290 passing a C<package> option allows you to place the plugin method in a
 291 different package other than your own.
 292
 293 =head2 file_regex
 294
 295 By default C<Module::Pluggable> only looks for I<.pm> files.
 296
 297 By supplying a new C<file_regex> then you can change this behaviour e.g
 298
 299     file_regex => qr/\.plugin$/
 300
 301 =head2 include_editor_junk
 302
 303 By default C<Module::Pluggable> ignores files that look like they were
 304 left behind by editors. Currently this means files ending in F<~> (~),
 305 the extensions F<.swp> or F<.swo>, or files beginning with F<.#>.
 306
 307 Setting C<include_editor_junk> changes C<Module::Pluggable> so it does
 308 not ignore any files it finds.
 309
 310
 311 =head1 METHODs
 312
 313 =head2 search_path
 314
 315 The method C<search_path> is exported into you namespace as well.
 316 You can call that at any time to change or replace the
 317 search_path.
 318
 319     $self->search_path( add => "New::Path" ); # add
 320     $self->search_path( new => "New::Path" ); # replace
 321
 322
 323
 324 =head1 FUTURE PLANS
 325
 326 This does everything I need and I can't really think of any other
 327 features I want to add. Famous last words of course
 328
 329 Recently tried fixed to find inner packages and to make it
 330 'just work' with PAR but there are still some issues.
 331
 332
 333 However suggestions (and patches) are welcome.
 334
 335 =head1 AUTHOR
 336
 337 Simon Wistow <simon@thegestalt.org>
 338
 339 =head1 COPYING
 340
 341 Copyright, 2006 Simon Wistow
 342
 343 Distributed under the same terms as Perl itself.
 344
 345 =head1 BUGS
 346
 347 None known.
 348
 349 =head1 SEE ALSO
 350
 351 L<File::Spec>, L<File::Find>, L<File::Basename>, L<Class::Factory::Util>, L<Module::Pluggable::Ordered>
 352
 353 =cut
 354
 355