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