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