1 package MooseX::Object::Pluggable;
6 use Module::Pluggable::Object;
8 our $VERSION = '0.0007';
12 MooseX::Object::Pluggable - Make your classes pluggable
19 with 'MooseX::Object::Pluggable';
23 package MyApp::Plugin::Pretty;
26 sub pretty{ print "I am pretty" }
33 $app->load_plugin('Pretty');
38 This module is meant to be loaded as a role from Moose-based classes
39 it will add five methods and four attributes to assist you with the loading
40 and handling of plugins and extensions for plugins. I understand that this may
41 pollute your namespace, however I took great care in using the least ambiguous
44 =head1 How plugins Work
46 Plugins and extensions are just Roles by a fancy name. They are loaded at runtime
47 on demand and are instance, not class based. This means that if you have more than
48 one instance of a class they can all have different plugins loaded. This is a feature.
50 Plugin methods are allowed to C<around>, C<before>, C<after>
51 their consuming classes, so it is important to watch for load order as plugins can
52 and will overload each other. You may also add attributes through has.
54 Please note that when you load at runtime you lose the ability to wrap C<BUILD>
55 and roles using C<has> will not go through compile time checks like C<required>
58 Even though C<override> will work , I STRONGLY discourage it's use
59 and a warning will be thrown if you try to use it.
60 This is closely linked to the way multiple roles being applied is handled and is not
61 likely to change. C<override> bevavior is closely linked to inheritance and thus will
62 likely not work as you expect it in multiple inheritance situations. Point being,
63 save yourself the headache.
65 =head1 How plugins are loaded
67 When roles are applied at runtime an anonymous class will wrap your class and
68 C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object,
69 they will instead return the name of the anonymous class created at runtime.
70 See C<_original_class_name>.
72 =head1 Notice regarding extensions.
74 Because I have been able to identify a real-world use case for the extension mechanism
75 I have decided to deprecate it and remove it in the next major release.
79 For a simple example see the tests included in this distribution.
85 String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
89 Boolean. Indicates whether we should attempt to load plugin extensions.
94 B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
95 this, please email me, but I am fairly sure that nobody uses this at
96 all and it's just adding bloat and making things kind of ugly.
98 String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.
100 This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
101 "ExtensionFor" loading plugin "Bar" would search for extensions in
102 "MyApp::Plugin::Bar::ExtensionFor::*".
104 =head2 _plugin_app_ns
106 ArrayRef, Accessor automatically dereferences into array on a read call.
107 By default will be filled with the class name and it's prescedents, it is used
108 to determine which directories to look for plugins as well as which plugins
109 take presedence upon namespace collitions. This allows you to subclass a pluggable
110 class and still use it's plugins while using yours first if they are available.
114 =head2 _plugin_locator
116 An automatically built instance of L<Module::Pluggable::Object> used to locate
121 #--------#---------#---------#---------#---------#---------#---------#---------#
123 has _plugin_ns => (is => 'rw', required => 1, isa => 'Str',
124 default => 'Plugin');
125 has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool',
127 has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str',
128 default => 'ExtensionFor');
129 has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
130 default => sub{ {} });
131 has _plugin_app_ns => (is => 'rw', required => 1, isa => 'ArrayRef', lazy => 1,
133 default => sub{ shift->_build_plugin_app_ns },
134 trigger => sub{ $_[0]->_clear_plugin_locator
135 if $_[0]->_has_plugin_locator; },
137 has _plugin_locator => (is => 'rw', required => 1, lazy => 1,
138 isa => 'Module::Pluggable::Object',
139 clearer => '_clear_plugin_locator',
140 predicate => '_has_plugin_locator',
141 default => sub{ shift->_build_plugin_locator });
143 #--------#---------#---------#---------#---------#---------#---------#---------#
145 =head1 Public Methods
147 =head2 load_plugins @plugins
149 =head2 load_plugin $plugin
151 Load the apropriate role for C<$plugin> as well as any extensions it provides
152 if extensions are enabled.
157 my ($self, @plugins) = @_;
158 die("You must provide a plugin name") unless @plugins;
160 my $loaded = $self->_plugin_loaded;
162 my @load = grep { not exists $loaded->{$_} } @plugins;
164 my @roles = map { $self->_role_from_plugin($_) } @load;
166 if ( $self->_load_and_apply_role(@roles) ) {
167 @{ $loaded }{@load} = @roles;
169 if ( $self->_plugin_ext ) {
170 $self->load_plugin_ext($_) for @load;
182 $self->load_plugins(@_);
186 =head2 load_plugin_ext
188 B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
189 this, please email me, but I am fairly sure that nobody uses this at
190 all and it's just adding bloat and making things kind of ugly.
192 Will load any extensions for a particular plugin. This should be called
193 automatically by C<load_plugin> so you don't need to worry about it.
194 It basically attempts to load any extension that exists for a plugin
195 that is already loaded. The only reason for using this is if you want to
196 keep _plugin_ext as false and only load extensions manually, which I don't
202 my ($self, $plugin) = @_;
203 die("You must provide a plugin name") unless $plugin;
204 my $role = $self->_plugin_loaded->{$plugin};
206 # $p for plugin, $r for role
207 while( my($p,$r) = each %{ $self->_plugin_loaded }){
209 my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
210 if( $plugin =~ /^\+(.*)/ ){
211 eval{ $self->_load_and_apply_role( $ext ) };
213 $self->_load_and_apply_role( $ext ) if
214 grep{ /^${ext}$/ } $self->_plugin_locator->plugins;
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);
224 =head2 _original_class_name
226 Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
227 no longer return what you expect. Instead use this class to get your original
232 sub _original_class_name{
234 return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
238 =head1 Private Methods
240 There's nothing stopping you from using these, but if you are using them
241 for anything thats not really complicated you are probably doing
242 something wrong. Some of these may be inlined in the future if performance
243 becomes an issue (which I doubt).
245 =head2 _role_from_plugin $plugin
247 Creates a role name from a plugin name. If the plugin name is prepended
248 with a C<+> it will be treated as a full name returned as is. Otherwise
249 a string consisting of C<$plugin> prepended with the C<_plugin_ns>
250 and the first valid value from C<_plugin_app_ns> will be returned. Example
252 #assuming appname MyApp and C<_plugin_ns> 'Plugin'
253 $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
257 sub _role_from_plugin{
258 my ($self, $plugin) = @_;
260 return $1 if( $plugin =~ /^\+(.*)/ );
262 my $o = join '::', $self->_plugin_ns, $plugin;
263 #Father, please forgive me for I have sinned.
264 my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins;
266 croak("Unable to locate plugin '$plugin'") unless @roles;
267 return $roles[0] if @roles == 1;
270 my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns;
272 @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
277 =head2 _load_and_apply_role @roles
279 Require C<$role> if it is not already loaded and apply it. This is
280 the meat of this module.
284 sub _load_and_apply_role{
285 my ($self, @roles) = @_;
286 die("You must provide a role name") unless @roles;
288 foreach my $role ( @roles ) {
289 eval { Class::MOP::load_class($role) };
290 confess("Failed to load role: ${role} $@") if $@;
292 carp("Using 'override' is strongly discouraged and may not behave ".
293 "as you expect it to. Please use 'around'")
294 if scalar keys %{ $role->meta->get_override_method_modifiers_map };
297 Moose::Util::apply_all_roles( $self, @roles );
302 =head2 _build_plugin_app_ns
304 Automatically builds the _plugin_app_ns attribute with the classes in the
305 class presedence list that are not part of Moose.
309 sub _build_plugin_app_ns{
311 my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
315 =head2 _build_plugin_locator
317 Automatically creates a L<Module::Pluggable::Object> instance with the correct
322 sub _build_plugin_locator{
325 my $locator = Module::Pluggable::Object->new
327 [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ]
334 Keep tests happy. See L<Moose>
344 L<Moose>, L<Moose::Role>, L<Class::Inspector>
348 Guillermo Roditi, <groditi@cpan.org>
354 Please report any bugs or feature requests to
355 C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
356 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
357 I will be notified, and then you'll automatically be notified of progress on
358 your bug as I make changes.
362 You can find documentation for this module with the perldoc command.
364 perldoc MooseX-Object-Pluggable
366 You can also look for information at:
370 =item * AnnoCPAN: Annotated CPAN documentation
372 L<http://annocpan.org/dist/MooseX-Object-Pluggable>
376 L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
378 =item * RT: CPAN's request tracker
380 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
384 L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
388 =head1 ACKNOWLEDGEMENTS
392 =item #Moose - Huge number of questions
394 =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
396 =item Stevan Little - EVERYTHING. Without him this would have never happened.
402 Copyright 2007 Guillermo Roditi. All Rights Reserved. This is
403 free software; you may redistribute it and/or modify it under the same
404 terms as Perl itself.