lib/MooseX/Object/Pluggable.pm

   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
 107 =head2 _plugin_subclass
 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
 113 automatically generated.
 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
 129 has _plugin_subclass => ( is => 'rw', required => 0, isa => 'Object', );
 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
 194 =head2 BUILD
 195
 196 Extend BUILD to create a suitable C<anon_subclass>.
 197
 198 =cut
 199
 200 around BUILD => sub {
 201     my ($super,$self) = @_;
 202
 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 };
 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
 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
 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