| 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.4'; |
| 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 | |