0.0007 changes
[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>
9bef9c02 55and roles using C<has> will not go through comile time checks like C<required>
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.
60This is closely linked to the way multiple roles being applies is handles and is not
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
147=head2 load_plugin $plugin
148
9843fa64 149Load the apropriate role for C<$plugin> as well as any extensions it provides
150if extensions are enabled.
421e9f8d 151
152=cut
153
154sub load_plugin{
155 my ($self, $plugin) = @_;
156 die("You must provide a plugin name") unless $plugin;
157
158 my $loaded = $self->_plugin_loaded;
159 return 1 if exists $loaded->{$plugin};
9843fa64 160
421e9f8d 161 my $role = $self->_role_from_plugin($plugin);
162
163 $loaded->{$plugin} = $role if $self->_load_and_apply_role($role);
164 $self->load_plugin_ext($plugin) if $self->_plugin_ext;
165
166 return exists $loaded->{$plugin};
167}
168
9843fa64 169=head2 load_plugins @plugins
170
171Load all C<@plugins>.
172
173=cut
174
175
176sub load_plugins {
177 my $self = shift;
178 $self->load_plugin($_) for @_;
179}
180
421e9f8d 181
12d4facb 182=head2 load_plugin_ext
421e9f8d 183
9843fa64 184B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
185this, please email me, but I am fairly sure that nobody uses this at
186all and it's just adding bloat and making things kind of ugly.
187
188Will load any extensions for a particular plugin. This should be called
421e9f8d 189automatically by C<load_plugin> so you don't need to worry about it.
9843fa64 190It basically attempts to load any extension that exists for a plugin
421e9f8d 191that is already loaded. The only reason for using this is if you want to
192keep _plugin_ext as false and only load extensions manually, which I don't
193recommend.
194
195=cut
196
197sub load_plugin_ext{
198 my ($self, $plugin) = @_;
199 die("You must provide a plugin name") unless $plugin;
208f7b27 200 my $role = $self->_plugin_loaded->{$plugin};
421e9f8d 201
202 # $p for plugin, $r for role
203 while( my($p,$r) = each %{ $self->_plugin_loaded }){
421e9f8d 204
9843fa64 205 my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
206 if( $plugin =~ /^\+(.*)/ ){
207 eval{ $self->_load_and_apply_role( $ext ) };
208 } else{
209 $self->_load_and_apply_role( $ext ) if
210 grep{ /^${ext}$/ } $self->_plugin_locator->plugins;
208f7b27 211 }
9843fa64 212
213 #go back to prev loaded modules and load extensions for current module?
214 #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
215 #$self->_load_and_apply_role( $ext2 )
216 # if Class::Inspector->installed($ext2);
421e9f8d 217 }
218}
219
9bef9c02 220=head2 _original_class_name
421e9f8d 221
9bef9c02 222Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
223no longer return what you expect. Instead use this class to get your original
224class name.
421e9f8d 225
226=cut
227
9bef9c02 228sub _original_class_name{
421e9f8d 229 my $self = shift;
9bef9c02 230 return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
421e9f8d 231}
232
9bef9c02 233
234=head1 Private Methods
235
9843fa64 236There's nothing stopping you from using these, but if you are using them
237for anything thats not really complicated you are probably doing
9bef9c02 238something wrong. Some of these may be inlined in the future if performance
239becomes an issue (which I doubt).
240
421e9f8d 241=head2 _role_from_plugin $plugin
242
9843fa64 243Creates a role name from a plugin name. If the plugin name is prepended
421e9f8d 244with a C<+> it will be treated as a full name returned as is. Otherwise
9843fa64 245a string consisting of C<$plugin> prepended with the C<_plugin_ns>
208f7b27 246and the first valid value from C<_plugin_app_ns> will be returned. Example
9843fa64 247
248 #assuming appname MyApp and C<_plugin_ns> 'Plugin'
421e9f8d 249 $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
250
251=cut
252
253sub _role_from_plugin{
254 my ($self, $plugin) = @_;
255
208f7b27 256 return $1 if( $plugin =~ /^\+(.*)/ );
257
258 my $o = join '::', $self->_plugin_ns, $plugin;
9843fa64 259 #Father, please forgive me for I have sinned.
208f7b27 260 my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins;
9843fa64 261
208f7b27 262 die("Unable to locate plugin") unless @roles;
263 return $roles[0] if @roles == 1;
9843fa64 264
208f7b27 265 my $i = 0;
0a369903 266 my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns;
9843fa64 267
208f7b27 268 @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
421e9f8d 269
9843fa64 270 return shift @roles;
421e9f8d 271}
272
273=head2 _load_and_apply_role $role
274
9bef9c02 275Require C<$role> if it is not already loaded and apply it. This is
276the meat of this module.
421e9f8d 277
278=cut
279
280sub _load_and_apply_role{
281 my ($self, $role) = @_;
282 die("You must provide a role name") unless $role;
283
0e16871f 284 eval { Class::MOP::load_class($role) };
285 confess("Failed to load role: ${role} $@") if $@;
421e9f8d 286
287 carp("Using 'override' is strongly discouraged and may not behave ".
9843fa64 288 "as you expect it to. Please use 'around'")
289 if scalar keys %{ $role->meta->get_override_method_modifiers_map };
421e9f8d 290
0e16871f 291 $role->meta->apply( $self );
421e9f8d 292 return 1;
293}
294
208f7b27 295=head2 _build_plugin_app_ns
296
297Automatically builds the _plugin_app_ns attribute with the classes in the
298class presedence list that are not part of Moose.
299
300=cut
301
302sub _build_plugin_app_ns{
303 my $self = shift;
304 my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
305 return \@names;
306}
307
308=head2 _build_plugin_locator
309
310Automatically creates a L<Module::Pluggable::Object> instance with the correct
311search_path.
312
313=cut
314
315sub _build_plugin_locator{
316 my $self = shift;
317
318 my $locator = Module::Pluggable::Object->new
9843fa64 319 ( search_path =>
320 [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ]
321 );
322 return $locator;
208f7b27 323}
324
12d4facb 325=head2 meta
326
327Keep tests happy. See L<Moose>
328
329=cut
330
421e9f8d 3311;
332
333__END__;
334
335=head1 SEE ALSO
336
9bef9c02 337L<Moose>, L<Moose::Role>, L<Class::Inspector>
421e9f8d 338
339=head1 AUTHOR
340
341Guillermo Roditi, <groditi@cpan.org>
342
343=head1 BUGS
344
345Holler?
346
347Please report any bugs or feature requests to
348C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
349L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
350I will be notified, and then you'll automatically be notified of progress on
351your bug as I make changes.
352
353=head1 SUPPORT
354
355You can find documentation for this module with the perldoc command.
356
357 perldoc MooseX-Object-Pluggable
358
359You can also look for information at:
360
361=over 4
362
363=item * AnnoCPAN: Annotated CPAN documentation
364
365L<http://annocpan.org/dist/MooseX-Object-Pluggable>
366
367=item * CPAN Ratings
368
369L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
370
371=item * RT: CPAN's request tracker
372
373L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
374
375=item * Search CPAN
376
377L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
378
379=back
380
381=head1 ACKNOWLEDGEMENTS
382
383=over 4
384
385=item #Moose - Huge number of questions
386
387=item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
388
389=item Stevan Little - EVERYTHING. Without him this would have never happened.
390
391=back
392
393=head1 COPYRIGHT
394
395Copyright 2007 Guillermo Roditi. All Rights Reserved. This is
396free software; you may redistribute it and/or modify it under the same
397terms as Perl itself.
398
399=cut