load_plugins withs all the plugins in one go
[gitmo/MooseX-Object-Pluggable.git] / lib / MooseX / Object / Pluggable.pm
CommitLineData
421e9f8d 1package MooseX::Object::Pluggable;
2
3use Carp;
421e9f8d 4use Moose::Role;
208f7b27 5use Class::MOP;
6use Module::Pluggable::Object;
421e9f8d 7
0e16871f 8our $VERSION = '0.0007';
421e9f8d 9
10=head1 NAME
11
12 MooseX::Object::Pluggable - Make your classes pluggable
13
14=head1 SYNOPSIS
15
16 package MyApp;
17 use Moose;
9843fa64 18
421e9f8d 19 with 'MooseX::Object::Pluggable';
20
21 ...
22
23 package MyApp::Plugin::Pretty;
24 use Moose::Role;
25
26 sub pretty{ print "I am pretty" }
27
28 1;
29
30 #
31 use MyApp;
32 my $app = MyApp->new;
33 $app->load_plugin('Pretty');
34 $app->pretty;
35
36=head1 DESCRIPTION
37
38This module is meant to be loaded as a role from Moose-based classes
9bef9c02 39it will add five methods and four attributes to assist you with the loading
421e9f8d 40and handling of plugins and extensions for plugins. I understand that this may
41pollute your namespace, however I took great care in using the least ambiguous
42names possible.
43
44=head1 How plugins Work
45
46Plugins and extensions are just Roles by a fancy name. They are loaded at runtime
47on demand and are instance, not class based. This means that if you have more than
48one instance of a class they can all have different plugins loaded. This is a feature.
49
50Plugin methods are allowed to C<around>, C<before>, C<after>
51their consuming classes, so it is important to watch for load order as plugins can
52and will overload each other. You may also add attributes through has.
53
06c9b714 54Please note that when you load at runtime you lose the ability to wrap C<BUILD>
cb251ecc 55and roles using C<has> will not go through compile time checks like C<required>
9bef9c02 56and <default>.
57
9843fa64 58Even though C<override> will work , I STRONGLY discourage it's use
421e9f8d 59and a warning will be thrown if you try to use it.
cb251ecc 60This is closely linked to the way multiple roles being applied is handled and is not
421e9f8d 61likely to change. C<override> bevavior is closely linked to inheritance and thus will
62likely not work as you expect it in multiple inheritance situations. Point being,
63save yourself the headache.
64
65=head1 How plugins are loaded
66
9bef9c02 67When roles are applied at runtime an anonymous class will wrap your class and
421e9f8d 68C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object,
9bef9c02 69they will instead return the name of the anonymous class created at runtime.
70See C<_original_class_name>.
421e9f8d 71
9843fa64 72=head1 Notice regarding extensions.
73
74Because I have been able to identify a real-world use case for the extension mechanism
75I have decided to deprecate it and remove it in the next major release.
76
9bef9c02 77=head1 Usage
421e9f8d 78
9bef9c02 79For a simple example see the tests included in this distribution.
421e9f8d 80
81=head1 Attributes
82
83=head2 _plugin_ns
84
85String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
86
87=head2 _plugin_ext
88
89Boolean. Indicates whether we should attempt to load plugin extensions.
90Defaults to true;
91
92=head2 _plugin_ext_ns
93
9843fa64 94B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
95this, please email me, but I am fairly sure that nobody uses this at
96all and it's just adding bloat and making things kind of ugly.
97
421e9f8d 98String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.
99
100This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
101"ExtensionFor" loading plugin "Bar" would search for extensions in
9843fa64 102"MyApp::Plugin::Bar::ExtensionFor::*".
421e9f8d 103
208f7b27 104=head2 _plugin_app_ns
421e9f8d 105
208f7b27 106ArrayRef, Accessor automatically dereferences into array on a read call.
107By default will be filled with the class name and it's prescedents, it is used
108to determine which directories to look for plugins as well as which plugins
109take presedence upon namespace collitions. This allows you to subclass a pluggable
110class and still use it's plugins while using yours first if they are available.
421e9f8d 111
421e9f8d 112=cut
113
208f7b27 114=head2 _plugin_locator
115
116An automatically built instance of L<Module::Pluggable::Object> used to locate
117available plugins.
118
119=cut
421e9f8d 120
208f7b27 121#--------#---------#---------#---------#---------#---------#---------#---------#
421e9f8d 122
9843fa64 123has _plugin_ns => (is => 'rw', required => 1, isa => 'Str',
208f7b27 124 default => 'Plugin');
125has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool',
9843fa64 126 default => 1);
127has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str',
128 default => 'ExtensionFor');
129has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
130 default => sub{ {} });
131has _plugin_app_ns => (is => 'rw', required => 1, isa => 'ArrayRef', lazy => 1,
132 auto_deref => 1,
0a369903 133 default => sub{ shift->_build_plugin_app_ns },
9843fa64 134 trigger => sub{ $_[0]->_clear_plugin_locator
0a369903 135 if $_[0]->_has_plugin_locator; },
136 );
9843fa64 137has _plugin_locator => (is => 'rw', required => 1, lazy => 1,
138 isa => 'Module::Pluggable::Object',
139 clearer => '_clear_plugin_locator',
0a369903 140 predicate => '_has_plugin_locator',
141 default => sub{ shift->_build_plugin_locator });
421e9f8d 142
421e9f8d 143#--------#---------#---------#---------#---------#---------#---------#---------#
144
145=head1 Public Methods
146
485dad3c 147=head2 load_plugins @plugins
148
421e9f8d 149=head2 load_plugin $plugin
150
9843fa64 151Load the apropriate role for C<$plugin> as well as any extensions it provides
152if extensions are enabled.
421e9f8d 153
154=cut
155
485dad3c 156sub load_plugins {
157 my ($self, @plugins) = @_;
158 die("You must provide a plugin name") unless @plugins;
421e9f8d 159
160 my $loaded = $self->_plugin_loaded;
421e9f8d 161
485dad3c 162 my @load = grep { not exists $loaded->{$_} } @plugins;
421e9f8d 163
485dad3c 164 my @roles = map { $self->_role_from_plugin($_) } @load;
421e9f8d 165
485dad3c 166 if ( $self->_load_and_apply_role(@roles) ) {
167 @{ $loaded }{@load} = @roles;
9843fa64 168
485dad3c 169 if ( $self->_plugin_ext ) {
170 $self->load_plugin_ext($_) for @load;
171 }
9843fa64 172
485dad3c 173 return 1;
174 } else {
175 return;
176 }
177}
9843fa64 178
179
485dad3c 180sub load_plugin {
9843fa64 181 my $self = shift;
485dad3c 182 $self->load_plugins(@_);
9843fa64 183}
184
421e9f8d 185
12d4facb 186=head2 load_plugin_ext
421e9f8d 187
9843fa64 188B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
189this, please email me, but I am fairly sure that nobody uses this at
190all and it's just adding bloat and making things kind of ugly.
191
192Will load any extensions for a particular plugin. This should be called
421e9f8d 193automatically by C<load_plugin> so you don't need to worry about it.
9843fa64 194It basically attempts to load any extension that exists for a plugin
421e9f8d 195that is already loaded. The only reason for using this is if you want to
196keep _plugin_ext as false and only load extensions manually, which I don't
197recommend.
198
199=cut
200
201sub load_plugin_ext{
202 my ($self, $plugin) = @_;
203 die("You must provide a plugin name") unless $plugin;
208f7b27 204 my $role = $self->_plugin_loaded->{$plugin};
421e9f8d 205
206 # $p for plugin, $r for role
207 while( my($p,$r) = each %{ $self->_plugin_loaded }){
421e9f8d 208
9843fa64 209 my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
210 if( $plugin =~ /^\+(.*)/ ){
211 eval{ $self->_load_and_apply_role( $ext ) };
212 } else{
213 $self->_load_and_apply_role( $ext ) if
214 grep{ /^${ext}$/ } $self->_plugin_locator->plugins;
208f7b27 215 }
9843fa64 216
217 #go back to prev loaded modules and load extensions for current module?
218 #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
219 #$self->_load_and_apply_role( $ext2 )
220 # if Class::Inspector->installed($ext2);
421e9f8d 221 }
222}
223
9bef9c02 224=head2 _original_class_name
421e9f8d 225
9bef9c02 226Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
227no longer return what you expect. Instead use this class to get your original
228class name.
421e9f8d 229
230=cut
231
9bef9c02 232sub _original_class_name{
421e9f8d 233 my $self = shift;
9bef9c02 234 return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
421e9f8d 235}
236
9bef9c02 237
238=head1 Private Methods
239
9843fa64 240There's nothing stopping you from using these, but if you are using them
241for anything thats not really complicated you are probably doing
9bef9c02 242something wrong. Some of these may be inlined in the future if performance
243becomes an issue (which I doubt).
244
421e9f8d 245=head2 _role_from_plugin $plugin
246
9843fa64 247Creates a role name from a plugin name. If the plugin name is prepended
421e9f8d 248with a C<+> it will be treated as a full name returned as is. Otherwise
9843fa64 249a string consisting of C<$plugin> prepended with the C<_plugin_ns>
208f7b27 250and the first valid value from C<_plugin_app_ns> will be returned. Example
9843fa64 251
252 #assuming appname MyApp and C<_plugin_ns> 'Plugin'
421e9f8d 253 $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
254
255=cut
256
257sub _role_from_plugin{
258 my ($self, $plugin) = @_;
259
208f7b27 260 return $1 if( $plugin =~ /^\+(.*)/ );
261
262 my $o = join '::', $self->_plugin_ns, $plugin;
9843fa64 263 #Father, please forgive me for I have sinned.
208f7b27 264 my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins;
9843fa64 265
e091956e 266 croak("Unable to locate plugin '$plugin'") unless @roles;
208f7b27 267 return $roles[0] if @roles == 1;
9843fa64 268
208f7b27 269 my $i = 0;
0a369903 270 my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns;
9843fa64 271
208f7b27 272 @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
421e9f8d 273
9843fa64 274 return shift @roles;
421e9f8d 275}
276
485dad3c 277=head2 _load_and_apply_role @roles
421e9f8d 278
9bef9c02 279Require C<$role> if it is not already loaded and apply it. This is
280the meat of this module.
421e9f8d 281
282=cut
283
284sub _load_and_apply_role{
485dad3c 285 my ($self, @roles) = @_;
286 die("You must provide a role name") unless @roles;
421e9f8d 287
485dad3c 288 foreach my $role ( @roles ) {
289 eval { Class::MOP::load_class($role) };
290 confess("Failed to load role: ${role} $@") if $@;
421e9f8d 291
485dad3c 292 carp("Using 'override' is strongly discouraged and may not behave ".
293 "as you expect it to. Please use 'around'")
9843fa64 294 if scalar keys %{ $role->meta->get_override_method_modifiers_map };
485dad3c 295 }
296
297 Moose::Util::apply_all_roles( $self, @roles );
421e9f8d 298
299 return 1;
300}
301
208f7b27 302=head2 _build_plugin_app_ns
303
304Automatically builds the _plugin_app_ns attribute with the classes in the
305class presedence list that are not part of Moose.
306
307=cut
308
309sub _build_plugin_app_ns{
310 my $self = shift;
311 my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
312 return \@names;
313}
314
315=head2 _build_plugin_locator
316
317Automatically creates a L<Module::Pluggable::Object> instance with the correct
318search_path.
319
320=cut
321
322sub _build_plugin_locator{
323 my $self = shift;
324
325 my $locator = Module::Pluggable::Object->new
9843fa64 326 ( search_path =>
327 [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ]
328 );
329 return $locator;
208f7b27 330}
331
12d4facb 332=head2 meta
333
334Keep tests happy. See L<Moose>
335
336=cut
337
421e9f8d 3381;
339
340__END__;
341
342=head1 SEE ALSO
343
9bef9c02 344L<Moose>, L<Moose::Role>, L<Class::Inspector>
421e9f8d 345
346=head1 AUTHOR
347
348Guillermo Roditi, <groditi@cpan.org>
349
350=head1 BUGS
351
352Holler?
353
354Please report any bugs or feature requests to
355C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
356L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
357I will be notified, and then you'll automatically be notified of progress on
358your bug as I make changes.
359
360=head1 SUPPORT
361
362You can find documentation for this module with the perldoc command.
363
364 perldoc MooseX-Object-Pluggable
365
366You can also look for information at:
367
368=over 4
369
370=item * AnnoCPAN: Annotated CPAN documentation
371
372L<http://annocpan.org/dist/MooseX-Object-Pluggable>
373
374=item * CPAN Ratings
375
376L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
377
378=item * RT: CPAN's request tracker
379
380L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
381
382=item * Search CPAN
383
384L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
385
386=back
387
388=head1 ACKNOWLEDGEMENTS
389
390=over 4
391
392=item #Moose - Huge number of questions
393
394=item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
395
396=item Stevan Little - EVERYTHING. Without him this would have never happened.
397
398=back
399
400=head1 COPYRIGHT
401
402Copyright 2007 Guillermo Roditi. All Rights Reserved. This is
403free software; you may redistribute it and/or modify it under the same
404terms as Perl itself.
405
406=cut