1 package MooseX::Object::Pluggable;
5 use Class::Load 'load_class';
6 use Scalar::Util 'blessed';
7 use Module::Pluggable::Object;
9 our $VERSION = '0.0011';
13 MooseX::Object::Pluggable - Make your classes pluggable
20 with 'MooseX::Object::Pluggable';
24 package MyApp::Plugin::Pretty;
27 sub pretty{ print "I am pretty" }
34 $app->load_plugin('Pretty');
39 This module is meant to be loaded as a role from Moose-based classes
40 it will add five methods and four attributes to assist you with the loading
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
45 =head1 How plugins Work
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.
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.
55 Please note that when you load at runtime you lose the ability to wrap C<BUILD>
56 and roles using C<has> will not go through compile time checks like C<required>
59 Even though C<override> will work , I STRONGLY discourage it's use
60 and a warning will be thrown if you try to use it.
61 This is closely linked to the way multiple roles being applied is handled 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.
66 =head1 How plugins are loaded
68 When roles are applied at runtime an anonymous class will wrap your class and
69 C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object,
70 they will instead return the name of the anonymous class created at runtime.
71 See C<_original_class_name>.
75 For a simple example see the tests included in this distribution.
81 String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
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.
91 =head2 _plugin_locator
93 An automatically built instance of L<Module::Pluggable::Object> used to locate
96 =head2 _original_class_name
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.
105 #--------#---------#---------#---------#---------#---------#---------#---------#
111 default => sub{ 'Plugin' },
114 has _original_class_name => (
118 default => sub{ blessed($_[0]) },
121 has _plugin_loaded => (
128 has _plugin_app_ns => (
134 builder => '_build_plugin_app_ns',
135 trigger => sub{ $_[0]->_clear_plugin_locator if $_[0]->_has_plugin_locator; },
138 has _plugin_locator => (
142 isa => 'Module::Pluggable::Object',
143 clearer => '_clear_plugin_locator',
144 predicate => '_has_plugin_locator',
145 builder => '_build_plugin_locator'
148 #--------#---------#---------#---------#---------#---------#---------#---------#
150 =head1 Public Methods
152 =head2 load_plugins @plugins
154 =head2 load_plugin $plugin
156 Load the apropriate role for C<$plugin>.
161 my ($self, @plugins) = @_;
162 die("You must provide a plugin name") unless @plugins;
164 my $loaded = $self->_plugin_loaded;
165 my @load = grep { not exists $loaded->{$_} } @plugins;
166 my @roles = map { $self->_role_from_plugin($_) } @load;
168 return if @roles == 0;
170 if ( $self->_load_and_apply_role(@roles) ) {
171 @{ $loaded }{@load} = @roles;
181 $self->load_plugins(@_);
184 =head1 Private Methods
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
190 =head2 _role_from_plugin $plugin
192 Creates a role name from a plugin name. If the plugin name is prepended
193 with a C<+> it will be treated as a full name returned as is. Otherwise
194 a string consisting of C<$plugin> prepended with the C<_plugin_ns>
195 and the first valid value from C<_plugin_app_ns> will be returned. Example
197 #assuming appname MyApp and C<_plugin_ns> 'Plugin'
198 $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
202 sub _role_from_plugin{
203 my ($self, $plugin) = @_;
205 return $1 if( $plugin =~ /^\+(.*)/ );
207 my $o = join '::', $self->_plugin_ns, $plugin;
208 #Father, please forgive me for I have sinned.
209 my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins;
211 croak("Unable to locate plugin '$plugin'") unless @roles;
212 return $roles[0] if @roles == 1;
215 my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns;
217 @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
222 =head2 _load_and_apply_role @roles
224 Require C<$role> if it is not already loaded and apply it. This is
225 the meat of this module.
229 sub _load_and_apply_role{
230 my ($self, @roles) = @_;
231 die("You must provide a role name") unless @roles;
233 foreach my $role ( @roles ) {
234 eval { load_class($role) };
235 confess("Failed to load role: ${role} $@") if $@;
237 carp("Using 'override' is strongly discouraged and may not behave ".
238 "as you expect it to. Please use 'around'")
239 if scalar keys %{ $role->meta->get_override_method_modifiers_map };
242 Moose::Util::apply_all_roles( $self, @roles );
247 =head2 _build_plugin_app_ns
249 Automatically builds the _plugin_app_ns attribute with the classes in the
250 class presedence list that are not part of Moose.
254 sub _build_plugin_app_ns{
256 my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
260 =head2 _build_plugin_locator
262 Automatically creates a L<Module::Pluggable::Object> instance with the correct
267 sub _build_plugin_locator{
270 my $locator = Module::Pluggable::Object->new
272 [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ]
279 Keep tests happy. See L<Moose>
289 L<Moose>, L<Moose::Role>, L<Class::Inspector>
293 Guillermo Roditi, <groditi@cpan.org>
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.
307 You can find documentation for this module with the perldoc command.
309 perldoc MooseX-Object-Pluggable
311 You can also look for information at:
315 =item * AnnoCPAN: Annotated CPAN documentation
317 L<http://annocpan.org/dist/MooseX-Object-Pluggable>
321 L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
323 =item * RT: CPAN's request tracker
325 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
329 L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
333 =head1 ACKNOWLEDGEMENTS
337 =item #Moose - Huge number of questions
339 =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
341 =item Stevan Little - EVERYTHING. Without him this would have never happened.
343 =item Shawn M Moore - bugfixes
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.