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 upon first use.
 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 _plugin_subclass
 195
 196 Creates, if needed and returns the anonymous instance of the consuming objects
 197 subclass to which roles will be applied to.
 198
 199 =cut
 200
 201 sub _plugin_subclass{
 202     my $self = shift;
 203     my $anon_class = $self->__plugin_subclass;
 204
 205     #initialize if we havnt been initialized already.
 206     unless(ref $anon_class && $self->meta->is_anon_class){
 207
 208         #create an anon class that inherits from $self that plugins can be
 209         #applied to safely and store it within the $self instance.
 210         $anon_class = Moose::Meta::Class->
 211             create_anon_class(superclasses => [$self->meta->name]);
 212         $self->__plugin_subclass( $anon_class );
 213
 214         #rebless $self as the anon class which now inherits from ourselves
 215         #this allows the anon class to override methods in the consuming
 216         #class while keeping a stable name and set of superclasses
 217         bless $self => $anon_class->name
 218             unless $self->meta->name eq $anon_class->name;
 219     }
 220
 221     return $anon_class;
 222 }
 223
 224 =head2 _role_from_plugin $plugin
 225
 226 Creates a role name from a plugin name. If the plugin name is prepended
 227 with a C<+> it will be treated as a full name returned as is. Otherwise
 228 a string consisting of C<$plugin>  prepended with the application name
 229 and C<_plugin_ns> will be returned. Example
 230
 231    #assuming appname MyApp and C<_plugin_ns> 'Plugin'
 232    $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
 233
 234 =cut
 235
 236 sub _role_from_plugin{
 237     my ($self, $plugin) = @_;
 238
 239     my $name = $self->meta->is_anon_class ?
 240         ($self->meta->superclasses)[0] : $self->blessed;
 241
 242     $plugin =~ /^\+(.*)/ ? $1 : join '::', $name, $self->_plugin_ns, $plugin;
 243 }
 244
 245 =head2 _load_and_apply_role $role
 246
 247 Require C<$role> if it is not already loaded and apply it to
 248 C<_plugin_subclass>. This is the meat of this module.
 249
 250 =cut
 251
 252 sub _load_and_apply_role{
 253     my ($self, $role) = @_;
 254     die("You must provide a role name") unless $role;
 255
 256     #Throw exception if plugin is not installed
 257     die("$role is not available on this system")
 258         unless Class::Inspector->installed($role);
 259
 260     #don't re-require...
 261     unless( Class::Inspector->loaded($role) ){
 262         eval "require $role" || die("Failed to load role: $role");
 263     }
 264
 265     carp("Using 'override' is strongly discouraged and may not behave ".
 266          "as you expect it to. Please use 'around'")
 267         if scalar keys %{ $role->meta->get_override_method_modifiers_map };
 268
 269     #apply the plugin to the anon subclass
 270     die("Failed to apply plugin: $role")
 271         unless $role->meta->apply( $self->_plugin_subclass );
 272
 273     return 1;
 274 }
 275
 276
 277 1;
 278
 279 __END__;
 280
 281 =head1 SEE ALSO
 282
 283 L<Moose>, L<Moose::Role>
 284
 285 =head1 AUTHOR
 286
 287 Guillermo Roditi, <groditi@cpan.org>
 288
 289 =head1 BUGS
 290
 291 Holler?
 292
 293 Please report any bugs or feature requests to
 294 C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
 295 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
 296 I will be notified, and then you'll automatically be notified of progress on
 297 your bug as I make changes.
 298
 299 =head1 SUPPORT
 300
 301 You can find documentation for this module with the perldoc command.
 302
 303     perldoc MooseX-Object-Pluggable
 304
 305 You can also look for information at:
 306
 307 =over 4
 308
 309 =item * AnnoCPAN: Annotated CPAN documentation
 310
 311 L<http://annocpan.org/dist/MooseX-Object-Pluggable>
 312
 313 =item * CPAN Ratings
 314
 315 L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
 316
 317 =item * RT: CPAN's request tracker
 318
 319 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
 320
 321 =item * Search CPAN
 322
 323 L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
 324
 325 =back
 326
 327 =head1 ACKNOWLEDGEMENTS
 328
 329 =over 4
 330
 331 =item #Moose - Huge number of questions
 332
 333 =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
 334
 335 =item Stevan Little - EVERYTHING. Without him this would have never happened.
 336
 337 =back
 338
 339 =head1 COPYRIGHT
 340
 341 Copyright 2007 Guillermo Roditi.  All Rights Reserved.  This is
 342 free software; you may redistribute it and/or modify it under the same
 343 terms as Perl itself.
 344
 345 =cut