Commit | Line | Data |
421e9f8d |
1 | package MooseX::Object::Pluggable; |
2 | |
3 | use Carp; |
4 | use strict; |
5 | use warnings; |
6 | use Moose::Role; |
7 | use Class::Inspector; |
8 | |
9 | |
10 | our $VERSION = '0.0002'; |
11 | |
12 | =head1 NAME |
13 | |
14 | MooseX::Object::Pluggable - Make your classes pluggable |
15 | |
16 | =head1 SYNOPSIS |
17 | |
18 | package MyApp; |
19 | use Moose; |
20 | |
21 | with 'MooseX::Object::Pluggable'; |
22 | |
23 | ... |
24 | |
25 | package MyApp::Plugin::Pretty; |
26 | use Moose::Role; |
27 | |
28 | sub pretty{ print "I am pretty" } |
29 | |
30 | 1; |
31 | |
32 | # |
33 | use MyApp; |
34 | my $app = MyApp->new; |
35 | $app->load_plugin('Pretty'); |
36 | $app->pretty; |
37 | |
38 | =head1 DESCRIPTION |
39 | |
40 | This module is meant to be loaded as a role from Moose-based classes |
41 | it will add five methods and five attributes to assist you with the loading |
42 | and handling of plugins and extensions for plugins. I understand that this may |
43 | pollute your namespace, however I took great care in using the least ambiguous |
44 | names possible. |
45 | |
46 | =head1 How plugins Work |
47 | |
48 | Plugins and extensions are just Roles by a fancy name. They are loaded at runtime |
49 | on demand and are instance, not class based. This means that if you have more than |
50 | one instance of a class they can all have different plugins loaded. This is a feature. |
51 | |
52 | Plugin methods are allowed to C<around>, C<before>, C<after> |
53 | their consuming classes, so it is important to watch for load order as plugins can |
54 | and will overload each other. You may also add attributes through has. |
55 | |
56 | Even thouch C<override> will work in basic cases, I STRONGLY discourage it's use |
57 | and a warning will be thrown if you try to use it. |
58 | This is closely linked to the way multiple roles being applies is handles and is not |
59 | likely to change. C<override> bevavior is closely linked to inheritance and thus will |
60 | likely not work as you expect it in multiple inheritance situations. Point being, |
61 | save yourself the headache. |
62 | |
63 | =head1 How plugins are loaded |
64 | |
65 | You don't really need to understand anything except for the first paragraph. |
66 | |
67 | The first time you load a plugin a new anonymous L<Moose::Meta::Class> will be |
68 | created. This class will inherit from your pluggable object and then your object |
69 | will be reblessed to an instance of this anonymous class. This means that |
70 | C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object, |
71 | they will instead return the name of the anonymous class created at runtime. Your |
72 | original class name can be located at C<($self-E<gt>meta-E<gt>superclasses)[0]> |
73 | |
74 | Once the anonymous subclass exists all plugin roles will be C<apply>ed to this class |
75 | directly. This "subclass" though is in fact now C<$self> and it C<isa($yourclassname)>. |
76 | If this is confusing.. it should be, thats why you let me handle it. Just know that it |
77 | has to be done this way in order for plugins to override core functionality. |
78 | |
79 | =head1 |
80 | |
81 | For a simple example see the tests for this distribution. |
82 | |
83 | =head1 Attributes |
84 | |
85 | =head2 _plugin_ns |
86 | |
87 | String. The prefix to use for plugin names provided. MyApp::Plugin is sensible. |
88 | |
89 | =head2 _plugin_ext |
90 | |
91 | Boolean. Indicates whether we should attempt to load plugin extensions. |
92 | Defaults to true; |
93 | |
94 | =head2 _plugin_ext_ns |
95 | |
96 | String. The namespace plugin extensions have. Defaults to 'ExtensionFor'. |
97 | |
98 | This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is |
99 | "ExtensionFor" loading plugin "Bar" would search for extensions in |
100 | "MyApp::Plugin::Bar::ExtensionFor::*". |
101 | |
102 | =head2 _plugin_loaded |
103 | |
104 | HashRef. Keeps an inventory of what plugins are loaded and what the actual |
105 | module name is to avoid multiple loading. |
106 | |
44b04eb5 |
107 | =head2 _plugin_subclass |
421e9f8d |
108 | |
109 | Object. This holds the subclass of our pluggable object in the form of an |
110 | anonymous L<Moose::Meta::Class> instance. All roles are actually applied to |
111 | this instance instead of the original class instance in order to not lose |
112 | the original object name as roles are applied. The anonymous class will be |
44b04eb5 |
113 | automatically generated. |
421e9f8d |
114 | |
115 | =cut |
116 | |
117 | #--------#---------#---------#---------#---------#---------#---------#---------# |
118 | |
119 | has _plugin_ns => (is => 'rw', required => 1, isa => 'Str', |
120 | default => 'Plugin'); |
121 | |
122 | has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool', |
123 | default => 1); |
124 | has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str', |
125 | default => 'ExtensionFor'); |
126 | has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef', |
127 | default => sub{ {} }); |
128 | |
44b04eb5 |
129 | has _plugin_subclass => ( is => 'rw', required => 0, isa => 'Object', ); |
421e9f8d |
130 | |
131 | #--------#---------#---------#---------#---------#---------#---------#---------# |
132 | |
133 | =head1 Public Methods |
134 | |
135 | =head2 load_plugin $plugin |
136 | |
137 | This is the only method you should be using. |
138 | Load the apropriate role for C<$plugin> as well as any |
139 | extensions it provides if extensions are enabled. |
140 | |
141 | =cut |
142 | |
143 | sub load_plugin{ |
144 | my ($self, $plugin) = @_; |
145 | die("You must provide a plugin name") unless $plugin; |
146 | |
147 | my $loaded = $self->_plugin_loaded; |
148 | return 1 if exists $loaded->{$plugin}; |
149 | |
150 | my $role = $self->_role_from_plugin($plugin); |
151 | |
152 | $loaded->{$plugin} = $role if $self->_load_and_apply_role($role); |
153 | $self->load_plugin_ext($plugin) if $self->_plugin_ext; |
154 | |
155 | return exists $loaded->{$plugin}; |
156 | } |
157 | |
158 | |
159 | =head2 _load_plugin_ext |
160 | |
161 | Will load any extensions for a particular plugin. This should be called |
162 | automatically by C<load_plugin> so you don't need to worry about it. |
163 | It basically attempts to load any extension that exists for a plugin |
164 | that is already loaded. The only reason for using this is if you want to |
165 | keep _plugin_ext as false and only load extensions manually, which I don't |
166 | recommend. |
167 | |
168 | =cut |
169 | |
170 | sub load_plugin_ext{ |
171 | my ($self, $plugin) = @_; |
172 | die("You must provide a plugin name") unless $plugin; |
173 | my $role = $self->_role_from_plugin($plugin); |
174 | |
175 | # $p for plugin, $r for role |
176 | while( my($p,$r) = each %{ $self->_plugin_loaded }){ |
177 | my $ext = join "::", $role, $self->_plugin_ext_ns, $p; |
178 | |
179 | $self->_load_and_apply_role( $ext ) |
180 | if Class::Inspector->installed($ext); |
181 | |
182 | #go back to prev loaded modules and load extensions for current module? |
183 | #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin; |
184 | #$self->_load_and_apply_role( $ext2 ) |
185 | # if Class::Inspector->installed($ext2); |
186 | } |
187 | } |
188 | |
189 | =head1 Private Methods |
190 | |
191 | There's nothing stopping you from using these, but if you are using them |
192 | you are probably doing something wrong. |
193 | |
44b04eb5 |
194 | =head2 BUILD |
421e9f8d |
195 | |
44b04eb5 |
196 | Extend BUILD to create a suitable C<anon_subclass>. |
421e9f8d |
197 | |
198 | =cut |
199 | |
44b04eb5 |
200 | around BUILD => sub { |
201 | my ($super,$self) = @_; |
421e9f8d |
202 | |
44b04eb5 |
203 | #create an anon class that inherits from $self that plugins can be |
204 | #applied to safely and store it within the $self instance. |
205 | my $anon_class = Moose::Meta::Class-> |
206 | create_anon_class(superclasses => [$self->meta->name]); |
207 | $self->_plugin_subclass( $anon_class ); |
208 | |
209 | #rebless $self as the anon class which now inherits from ourselves |
210 | #this allows the anon class to override methods in the consuming |
211 | #class while keeping a stable name and set of superclasses |
212 | bless $self => $anon_class->name |
213 | unless $self->meta->name eq $anon_class->name; |
214 | |
215 | $super->($self); |
216 | }; |
421e9f8d |
217 | |
218 | =head2 _role_from_plugin $plugin |
219 | |
220 | Creates a role name from a plugin name. If the plugin name is prepended |
221 | with a C<+> it will be treated as a full name returned as is. Otherwise |
222 | a string consisting of C<$plugin> prepended with the application name |
223 | and C<_plugin_ns> will be returned. Example |
224 | |
225 | #assuming appname MyApp and C<_plugin_ns> 'Plugin' |
226 | $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin |
227 | |
228 | =cut |
229 | |
230 | sub _role_from_plugin{ |
231 | my ($self, $plugin) = @_; |
232 | |
233 | my $name = $self->meta->is_anon_class ? |
234 | ($self->meta->superclasses)[0] : $self->blessed; |
235 | |
236 | $plugin =~ /^\+(.*)/ ? $1 : join '::', $name, $self->_plugin_ns, $plugin; |
237 | } |
238 | |
44b04eb5 |
239 | #sub original_class_name{ |
240 | # my $self = shift; |
241 | # |
242 | # $self->meta->is_anon_class ? |
243 | # ($self->meta->superclasses)[0] : $self->blessed; |
244 | #} |
245 | |
421e9f8d |
246 | =head2 _load_and_apply_role $role |
247 | |
248 | Require C<$role> if it is not already loaded and apply it to |
249 | C<_plugin_subclass>. This is the meat of this module. |
250 | |
251 | =cut |
252 | |
253 | sub _load_and_apply_role{ |
254 | my ($self, $role) = @_; |
255 | die("You must provide a role name") unless $role; |
256 | |
257 | #Throw exception if plugin is not installed |
258 | die("$role is not available on this system") |
259 | unless Class::Inspector->installed($role); |
260 | |
261 | #don't re-require... |
262 | unless( Class::Inspector->loaded($role) ){ |
263 | eval "require $role" || die("Failed to load role: $role"); |
264 | } |
265 | |
266 | carp("Using 'override' is strongly discouraged and may not behave ". |
267 | "as you expect it to. Please use 'around'") |
268 | if scalar keys %{ $role->meta->get_override_method_modifiers_map }; |
269 | |
270 | #apply the plugin to the anon subclass |
271 | die("Failed to apply plugin: $role") |
272 | unless $role->meta->apply( $self->_plugin_subclass ); |
273 | |
274 | return 1; |
275 | } |
276 | |
277 | |
278 | 1; |
279 | |
280 | __END__; |
281 | |
282 | =head1 SEE ALSO |
283 | |
284 | L<Moose>, L<Moose::Role> |
285 | |
286 | =head1 AUTHOR |
287 | |
288 | Guillermo Roditi, <groditi@cpan.org> |
289 | |
290 | =head1 BUGS |
291 | |
292 | Holler? |
293 | |
294 | Please report any bugs or feature requests to |
295 | C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at |
296 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>. |
297 | I will be notified, and then you'll automatically be notified of progress on |
298 | your bug as I make changes. |
299 | |
300 | =head1 SUPPORT |
301 | |
302 | You can find documentation for this module with the perldoc command. |
303 | |
304 | perldoc MooseX-Object-Pluggable |
305 | |
306 | You can also look for information at: |
307 | |
308 | =over 4 |
309 | |
310 | =item * AnnoCPAN: Annotated CPAN documentation |
311 | |
312 | L<http://annocpan.org/dist/MooseX-Object-Pluggable> |
313 | |
314 | =item * CPAN Ratings |
315 | |
316 | L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable> |
317 | |
318 | =item * RT: CPAN's request tracker |
319 | |
320 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable> |
321 | |
322 | =item * Search CPAN |
323 | |
324 | L<http://search.cpan.org/dist/MooseX-Object-Pluggable> |
325 | |
326 | =back |
327 | |
328 | =head1 ACKNOWLEDGEMENTS |
329 | |
330 | =over 4 |
331 | |
332 | =item #Moose - Huge number of questions |
333 | |
334 | =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning. |
335 | |
336 | =item Stevan Little - EVERYTHING. Without him this would have never happened. |
337 | |
338 | =back |
339 | |
340 | =head1 COPYRIGHT |
341 | |
342 | Copyright 2007 Guillermo Roditi. All Rights Reserved. This is |
343 | free software; you may redistribute it and/or modify it under the same |
344 | terms as Perl itself. |
345 | |
346 | =cut |