1 package MooseX::Object::Pluggable;
8 use Module::Pluggable::Object;
10 our $VERSION = '0.0005';
14 MooseX::Object::Pluggable - Make your classes pluggable
21 with 'MooseX::Object::Pluggable';
25 package MyApp::Plugin::Pretty;
28 sub pretty{ print "I am pretty" }
35 $app->load_plugin('Pretty');
40 This module is meant to be loaded as a role from Moose-based classes
41 it will add five methods and four 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
46 =head1 How plugins Work
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.
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.
56 Please note that when you load at runtime you lose the ability to wrap C<BUILD>
57 and roles using C<has> will not go through comile time checks like C<required>
60 Even though C<override> will work , I STRONGLY discourage it's use
61 and a warning will be thrown if you try to use it.
62 This is closely linked to the way multiple roles being applies is handles and is not
63 likely to change. C<override> bevavior is closely linked to inheritance and thus will
64 likely not work as you expect it in multiple inheritance situations. Point being,
65 save yourself the headache.
67 =head1 How plugins are loaded
69 When roles are applied at runtime an anonymous class will wrap your class and
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.
72 See C<_original_class_name>.
76 For a simple example see the tests included in this distribution.
82 String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
86 Boolean. Indicates whether we should attempt to load plugin extensions.
91 String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.
93 This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
94 "ExtensionFor" loading plugin "Bar" would search for extensions in
95 "MyApp::Plugin::Bar::ExtensionFor::*".
99 ArrayRef, Accessor automatically dereferences into array on a read call.
100 By default will be filled with the class name and it's prescedents, it is used
101 to determine which directories to look for plugins as well as which plugins
102 take presedence upon namespace collitions. This allows you to subclass a pluggable
103 class and still use it's plugins while using yours first if they are available.
107 =head2 _plugin_locator
109 An automatically built instance of L<Module::Pluggable::Object> used to locate
114 #--------#---------#---------#---------#---------#---------#---------#---------#
116 has _plugin_ns => (is => 'rw', required => 1, isa => 'Str',
117 default => 'Plugin');
118 has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool',
120 has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str',
121 default => 'ExtensionFor');
122 has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
123 default => sub{ {} });
124 has _plugin_app_ns => (is => 'rw', required => 1, isa => 'ArrayRef', lazy => 1,
126 default => sub{ shift->_build_plugin_app_ns },
127 trigger => sub{ $_[0]->_clear_plugin_locator
128 if $_[0]->_has_plugin_locator; },
130 has _plugin_locator => (is => 'rw', required => 1, lazy => 1,
131 isa => 'Module::Pluggable::Object',
132 clearer => '_clear_plugin_locator',
133 predicate => '_has_plugin_locator',
134 default => sub{ shift->_build_plugin_locator });
136 #--------#---------#---------#---------#---------#---------#---------#---------#
138 =head1 Public Methods
140 =head2 load_plugin $plugin
142 This is the only method you should be using. Load the apropriate role for
143 C<$plugin> as well as any extensions it provides if extensions are enabled.
148 my ($self, $plugin) = @_;
149 die("You must provide a plugin name") unless $plugin;
151 my $loaded = $self->_plugin_loaded;
152 return 1 if exists $loaded->{$plugin};
154 my $role = $self->_role_from_plugin($plugin);
156 $loaded->{$plugin} = $role if $self->_load_and_apply_role($role);
157 $self->load_plugin_ext($plugin) if $self->_plugin_ext;
159 return exists $loaded->{$plugin};
163 =head2 load_plugin_ext
165 Will load any extensions for a particular plugin. This should be called
166 automatically by C<load_plugin> so you don't need to worry about it.
167 It basically attempts to load any extension that exists for a plugin
168 that is already loaded. The only reason for using this is if you want to
169 keep _plugin_ext as false and only load extensions manually, which I don't
175 my ($self, $plugin) = @_;
176 die("You must provide a plugin name") unless $plugin;
177 my $role = $self->_plugin_loaded->{$plugin};
179 # $p for plugin, $r for role
180 while( my($p,$r) = each %{ $self->_plugin_loaded }){
182 my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
183 if( $plugin =~ /^\+(.*)/ ){
184 eval{ $self->_load_and_apply_role( $ext ) };
186 $self->_load_and_apply_role( $ext ) if
187 grep{ /^${ext}$/ } $self->_plugin_locator->plugins;
190 #go back to prev loaded modules and load extensions for current module?
191 #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
192 #$self->_load_and_apply_role( $ext2 )
193 # if Class::Inspector->installed($ext2);
197 =head2 _original_class_name
199 Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
200 no longer return what you expect. Instead use this class to get your original
205 sub _original_class_name{
207 return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
211 =head1 Private Methods
213 There's nothing stopping you from using these, but if you are using them
214 for anything thats not really complicated you are probably doing
215 something wrong. Some of these may be inlined in the future if performance
216 becomes an issue (which I doubt).
218 =head2 _role_from_plugin $plugin
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 C<_plugin_ns>
223 and the first valid value from C<_plugin_app_ns> will be returned. Example
225 #assuming appname MyApp and C<_plugin_ns> 'Plugin'
226 $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
230 sub _role_from_plugin{
231 my ($self, $plugin) = @_;
233 return $1 if( $plugin =~ /^\+(.*)/ );
235 my $o = join '::', $self->_plugin_ns, $plugin;
236 #Father, please forgive me for I have sinned.
237 my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins;
239 die("Unable to locate plugin") unless @roles;
240 return $roles[0] if @roles == 1;
243 my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns;
245 @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
250 =head2 _load_and_apply_role $role
252 Require C<$role> if it is not already loaded and apply it. This is
253 the meat of this module.
257 sub _load_and_apply_role{
258 my ($self, $role) = @_;
259 die("You must provide a role name") unless $role;
262 unless( Class::MOP::is_class_loaded($role) ){
263 eval Class::MOP::load_class($role) || die("Failed to load role: $role");
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 };
270 #apply the plugin to the anon subclass
271 die("Failed to apply plugin: $role")
272 unless $role->meta->apply( $self );
277 =head2 _build_plugin_app_ns
279 Automatically builds the _plugin_app_ns attribute with the classes in the
280 class presedence list that are not part of Moose.
284 sub _build_plugin_app_ns{
286 my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
290 =head2 _build_plugin_locator
292 Automatically creates a L<Module::Pluggable::Object> instance with the correct
297 sub _build_plugin_locator{
300 my $locator = Module::Pluggable::Object->new
302 [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ]
309 Keep tests happy. See L<Moose>
319 L<Moose>, L<Moose::Role>, L<Class::Inspector>
323 Guillermo Roditi, <groditi@cpan.org>
329 Please report any bugs or feature requests to
330 C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
331 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
332 I will be notified, and then you'll automatically be notified of progress on
333 your bug as I make changes.
337 You can find documentation for this module with the perldoc command.
339 perldoc MooseX-Object-Pluggable
341 You can also look for information at:
345 =item * AnnoCPAN: Annotated CPAN documentation
347 L<http://annocpan.org/dist/MooseX-Object-Pluggable>
351 L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
353 =item * RT: CPAN's request tracker
355 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
359 L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
363 =head1 ACKNOWLEDGEMENTS
367 =item #Moose - Huge number of questions
369 =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
371 =item Stevan Little - EVERYTHING. Without him this would have never happened.
377 Copyright 2007 Guillermo Roditi. All Rights Reserved. This is
378 free software; you may redistribute it and/or modify it under the same
379 terms as Perl itself.