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 | |
9bef9c02 |
9 | our $VERSION = '0.0003'; |
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; |
19 | |
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 | |
9bef9c02 |
55 | Please note that when you laod at runtime you lose the ability to wrap C<BUILD> |
56 | and roles using C<has> will not go through comile time checks like C<required> |
57 | and <default>. |
58 | |
59 | Even thouch C<override> will work , I STRONGLY discourage it's use |
421e9f8d |
60 | and a warning will be thrown if you try to use it. |
61 | This is closely linked to the way multiple roles being applies is handles and is not |
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 | |
83 | =head2 _plugin_ext |
84 | |
85 | Boolean. Indicates whether we should attempt to load plugin extensions. |
86 | Defaults to true; |
87 | |
88 | =head2 _plugin_ext_ns |
89 | |
90 | String. The namespace plugin extensions have. Defaults to 'ExtensionFor'. |
91 | |
92 | This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is |
93 | "ExtensionFor" loading plugin "Bar" would search for extensions in |
94 | "MyApp::Plugin::Bar::ExtensionFor::*". |
95 | |
96 | =head2 _plugin_loaded |
97 | |
98 | HashRef. Keeps an inventory of what plugins are loaded and what the actual |
99 | module name is to avoid multiple loading. |
100 | |
421e9f8d |
101 | =cut |
102 | |
103 | #--------#---------#---------#---------#---------#---------#---------#---------# |
104 | |
105 | has _plugin_ns => (is => 'rw', required => 1, isa => 'Str', |
106 | default => 'Plugin'); |
107 | |
108 | has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool', |
109 | default => 1); |
110 | has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str', |
111 | default => 'ExtensionFor'); |
112 | has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef', |
113 | default => sub{ {} }); |
114 | |
421e9f8d |
115 | #--------#---------#---------#---------#---------#---------#---------#---------# |
116 | |
117 | =head1 Public Methods |
118 | |
119 | =head2 load_plugin $plugin |
120 | |
9bef9c02 |
121 | This is the only method you should be using. Load the apropriate role for |
122 | C<$plugin> as well as any extensions it provides if extensions are enabled. |
421e9f8d |
123 | |
124 | =cut |
125 | |
126 | sub load_plugin{ |
127 | my ($self, $plugin) = @_; |
128 | die("You must provide a plugin name") unless $plugin; |
129 | |
130 | my $loaded = $self->_plugin_loaded; |
131 | return 1 if exists $loaded->{$plugin}; |
9bef9c02 |
132 | |
421e9f8d |
133 | my $role = $self->_role_from_plugin($plugin); |
134 | |
135 | $loaded->{$plugin} = $role if $self->_load_and_apply_role($role); |
136 | $self->load_plugin_ext($plugin) if $self->_plugin_ext; |
137 | |
138 | return exists $loaded->{$plugin}; |
139 | } |
140 | |
141 | |
142 | =head2 _load_plugin_ext |
143 | |
144 | Will load any extensions for a particular plugin. This should be called |
145 | automatically by C<load_plugin> so you don't need to worry about it. |
146 | It basically attempts to load any extension that exists for a plugin |
147 | that is already loaded. The only reason for using this is if you want to |
148 | keep _plugin_ext as false and only load extensions manually, which I don't |
149 | recommend. |
150 | |
151 | =cut |
152 | |
153 | sub load_plugin_ext{ |
154 | my ($self, $plugin) = @_; |
155 | die("You must provide a plugin name") unless $plugin; |
156 | my $role = $self->_role_from_plugin($plugin); |
157 | |
158 | # $p for plugin, $r for role |
159 | while( my($p,$r) = each %{ $self->_plugin_loaded }){ |
160 | my $ext = join "::", $role, $self->_plugin_ext_ns, $p; |
161 | |
162 | $self->_load_and_apply_role( $ext ) |
163 | if Class::Inspector->installed($ext); |
164 | |
165 | #go back to prev loaded modules and load extensions for current module? |
166 | #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin; |
167 | #$self->_load_and_apply_role( $ext2 ) |
168 | # if Class::Inspector->installed($ext2); |
169 | } |
170 | } |
171 | |
9bef9c02 |
172 | =head2 _original_class_name |
421e9f8d |
173 | |
9bef9c02 |
174 | Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will |
175 | no longer return what you expect. Instead use this class to get your original |
176 | class name. |
421e9f8d |
177 | |
178 | =cut |
179 | |
9bef9c02 |
180 | sub _original_class_name{ |
421e9f8d |
181 | my $self = shift; |
9bef9c02 |
182 | return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0]; |
421e9f8d |
183 | } |
184 | |
9bef9c02 |
185 | |
186 | =head1 Private Methods |
187 | |
188 | There's nothing stopping you from using these, but if you are using them |
189 | for anything thats not really complicated you are probably doing |
190 | something wrong. Some of these may be inlined in the future if performance |
191 | becomes an issue (which I doubt). |
192 | |
421e9f8d |
193 | =head2 _role_from_plugin $plugin |
194 | |
195 | Creates a role name from a plugin name. If the plugin name is prepended |
196 | with a C<+> it will be treated as a full name returned as is. Otherwise |
197 | a string consisting of C<$plugin> prepended with the application name |
198 | and C<_plugin_ns> will be returned. Example |
199 | |
200 | #assuming appname MyApp and C<_plugin_ns> 'Plugin' |
201 | $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin |
202 | |
203 | =cut |
204 | |
205 | sub _role_from_plugin{ |
206 | my ($self, $plugin) = @_; |
207 | |
9bef9c02 |
208 | return $1 if $plugin =~ /^\+(.*)/; |
421e9f8d |
209 | |
9bef9c02 |
210 | return join '::', ( $self->_original_class_name, |
211 | $self->_plugin_ns, $plugin ); |
421e9f8d |
212 | } |
213 | |
214 | =head2 _load_and_apply_role $role |
215 | |
9bef9c02 |
216 | Require C<$role> if it is not already loaded and apply it. This is |
217 | the meat of this module. |
421e9f8d |
218 | |
219 | =cut |
220 | |
221 | sub _load_and_apply_role{ |
222 | my ($self, $role) = @_; |
223 | die("You must provide a role name") unless $role; |
224 | |
225 | #Throw exception if plugin is not installed |
226 | die("$role is not available on this system") |
227 | unless Class::Inspector->installed($role); |
228 | |
229 | #don't re-require... |
230 | unless( Class::Inspector->loaded($role) ){ |
231 | eval "require $role" || die("Failed to load role: $role"); |
232 | } |
233 | |
9bef9c02 |
234 | |
421e9f8d |
235 | carp("Using 'override' is strongly discouraged and may not behave ". |
236 | "as you expect it to. Please use 'around'") |
237 | if scalar keys %{ $role->meta->get_override_method_modifiers_map }; |
238 | |
239 | #apply the plugin to the anon subclass |
240 | die("Failed to apply plugin: $role") |
9bef9c02 |
241 | unless $role->meta->apply( $self ); |
421e9f8d |
242 | |
243 | return 1; |
244 | } |
245 | |
421e9f8d |
246 | 1; |
247 | |
248 | __END__; |
249 | |
250 | =head1 SEE ALSO |
251 | |
9bef9c02 |
252 | L<Moose>, L<Moose::Role>, L<Class::Inspector> |
421e9f8d |
253 | |
254 | =head1 AUTHOR |
255 | |
256 | Guillermo Roditi, <groditi@cpan.org> |
257 | |
258 | =head1 BUGS |
259 | |
260 | Holler? |
261 | |
262 | Please report any bugs or feature requests to |
263 | C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at |
264 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>. |
265 | I will be notified, and then you'll automatically be notified of progress on |
266 | your bug as I make changes. |
267 | |
268 | =head1 SUPPORT |
269 | |
270 | You can find documentation for this module with the perldoc command. |
271 | |
272 | perldoc MooseX-Object-Pluggable |
273 | |
274 | You can also look for information at: |
275 | |
276 | =over 4 |
277 | |
278 | =item * AnnoCPAN: Annotated CPAN documentation |
279 | |
280 | L<http://annocpan.org/dist/MooseX-Object-Pluggable> |
281 | |
282 | =item * CPAN Ratings |
283 | |
284 | L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable> |
285 | |
286 | =item * RT: CPAN's request tracker |
287 | |
288 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable> |
289 | |
290 | =item * Search CPAN |
291 | |
292 | L<http://search.cpan.org/dist/MooseX-Object-Pluggable> |
293 | |
294 | =back |
295 | |
296 | =head1 ACKNOWLEDGEMENTS |
297 | |
298 | =over 4 |
299 | |
300 | =item #Moose - Huge number of questions |
301 | |
302 | =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning. |
303 | |
304 | =item Stevan Little - EVERYTHING. Without him this would have never happened. |
305 | |
306 | =back |
307 | |
308 | =head1 COPYRIGHT |
309 | |
310 | Copyright 2007 Guillermo Roditi. All Rights Reserved. This is |
311 | free software; you may redistribute it and/or modify it under the same |
312 | terms as Perl itself. |
313 | |
314 | =cut |