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 our $VERSION = '0.0004';
  10
  11 =head1 NAME
  12
  13     MooseX::Object::Pluggable - Make your classes pluggable
  14
  15 =head1 SYNOPSIS
  16
  17     package MyApp;
  18     use Moose;
  19
  20     with 'MooseX::Object::Pluggable';
  21
  22     ...
  23
  24     package MyApp::Plugin::Pretty;
  25     use Moose::Role;
  26
  27     sub pretty{ print "I am pretty" }
  28
  29     1;
  30
  31     #
  32     use MyApp;
  33     my $app = MyApp->new;
  34     $app->load_plugin('Pretty');
  35     $app->pretty;
  36
  37 =head1 DESCRIPTION
  38
  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
  43 names possible.
  44
  45 =head1 How plugins Work
  46
  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.
  50
  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.
  54
  55 Please note that when you laod at runtime you lose the ability to wrap C<BUILD>
  56 and roles using C<has> will not go through comile time checks like C<required>
  57 and <default>.
  58
  59 Even thouch 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 applies is handles 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.
  65
  66 =head1 How plugins are loaded
  67
  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>.
  72
  73 =head1 Usage
  74
  75 For a simple example see the tests included in this distribution.
  76
  77 =head1 Attributes
  78
  79 =head2 _plugin_ns
  80
  81 String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
  82
  83 =head2 _plugin_ext
  84
  85 Boolean. Indicates whether we should attempt to load plugin extensions.
  86 Defaults to true;
  87
  88 =head2 _plugin_ext_ns
  89
  90 String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.
  91
  92 This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
  93 "ExtensionFor" loading plugin "Bar" would search for extensions in
  94 "MyApp::Plugin::Bar::ExtensionFor::*".
  95
  96 =head2 _plugin_loaded
  97
  98 HashRef. Keeps an inventory of what plugins are loaded and what the actual
  99 module name is to avoid multiple loading.
 100
 101 =cut
 102
 103 #--------#---------#---------#---------#---------#---------#---------#---------#
 104
 105 has _plugin_ns     => (is => 'rw', required => 1, isa => 'Str',
 106                        default => 'Plugin');
 107
 108 has _plugin_ext    => (is => 'rw', required => 1, isa => 'Bool',
 109                        default => 1);
 110 has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str',
 111                        default => 'ExtensionFor');
 112 has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
 113                        default => sub{ {} });
 114
 115 #--------#---------#---------#---------#---------#---------#---------#---------#
 116
 117 =head1 Public Methods
 118
 119 =head2 load_plugin $plugin
 120
 121 This is the only method you should be using. Load the apropriate role for
 122 C<$plugin> as well as any extensions it provides if extensions are enabled.
 123
 124 =cut
 125
 126 sub load_plugin{
 127     my ($self, $plugin) = @_;
 128     die("You must provide a plugin name") unless $plugin;
 129
 130     my $loaded = $self->_plugin_loaded;
 131     return 1 if exists $loaded->{$plugin};
 132
 133     my $role = $self->_role_from_plugin($plugin);
 134
 135     $loaded->{$plugin} = $role      if $self->_load_and_apply_role($role);
 136     $self->load_plugin_ext($plugin) if $self->_plugin_ext;
 137
 138     return exists $loaded->{$plugin};
 139 }
 140
 141
 142 =head2 load_plugin_ext
 143
 144 Will load any extensions for a particular plugin. This should be called
 145 automatically by C<load_plugin> so you don't need to worry about it.
 146 It basically attempts to load any extension that exists for a plugin
 147 that is already loaded. The only reason for using this is if you want to
 148 keep _plugin_ext as false and only load extensions manually, which I don't
 149 recommend.
 150
 151 =cut
 152
 153 sub load_plugin_ext{
 154     my ($self, $plugin) = @_;
 155     die("You must provide a plugin name") unless $plugin;
 156     my $role = $self->_role_from_plugin($plugin);
 157
 158     # $p for plugin, $r for role
 159     while( my($p,$r) = each %{ $self->_plugin_loaded }){
 160         my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
 161
 162         $self->_load_and_apply_role( $ext )
 163             if Class::Inspector->installed($ext);
 164
 165         #go back to prev loaded modules and load extensions for current module?
 166         #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
 167         #$self->_load_and_apply_role( $ext2 )
 168         #    if Class::Inspector->installed($ext2);
 169     }
 170 }
 171
 172 =head2 _original_class_name
 173
 174 Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
 175 no longer return what you expect. Instead use this class to get your original
 176 class name.
 177
 178 =cut
 179
 180 sub _original_class_name{
 181     my $self = shift;
 182     return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
 183 }
 184
 185
 186 =head1 Private Methods
 187
 188 There's nothing stopping you from using these, but if you are using them
 189 for anything thats not really complicated you are probably doing
 190 something wrong. Some of these may be inlined in the future if performance
 191 becomes an issue (which I doubt).
 192
 193 =head2 _role_from_plugin $plugin
 194
 195 Creates a role name from a plugin name. If the plugin name is prepended
 196 with a C<+> it will be treated as a full name returned as is. Otherwise
 197 a string consisting of C<$plugin>  prepended with the application name
 198 and C<_plugin_ns> will be returned. Example
 199
 200    #assuming appname MyApp and C<_plugin_ns> 'Plugin'
 201    $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin
 202
 203 =cut
 204
 205 sub _role_from_plugin{
 206     my ($self, $plugin) = @_;
 207
 208     return $1 if $plugin =~ /^\+(.*)/;
 209
 210     return join '::', ( $self->_original_class_name,
 211                         $self->_plugin_ns, $plugin );
 212 }
 213
 214 =head2 _load_and_apply_role $role
 215
 216 Require C<$role> if it is not already loaded and apply it. This is
 217 the meat of this module.
 218
 219 =cut
 220
 221 sub _load_and_apply_role{
 222     my ($self, $role) = @_;
 223     die("You must provide a role name") unless $role;
 224
 225     #Throw exception if plugin is not installed
 226     die("$role is not available on this system")
 227         unless Class::Inspector->installed($role);
 228
 229     #don't re-require...
 230     unless( Class::Inspector->loaded($role) ){
 231         eval "require $role" || die("Failed to load role: $role");
 232     }
 233
 234
 235     carp("Using 'override' is strongly discouraged and may not behave ".
 236          "as you expect it to. Please use 'around'")
 237         if scalar keys %{ $role->meta->get_override_method_modifiers_map };
 238
 239     #apply the plugin to the anon subclass
 240     die("Failed to apply plugin: $role")
 241         unless $role->meta->apply( $self );
 242
 243     return 1;
 244 }
 245
 246 =head2 meta
 247
 248 Keep tests happy. See L<Moose>
 249
 250 =cut
 251
 252 1;
 253
 254 __END__;
 255
 256 =head1 SEE ALSO
 257
 258 L<Moose>, L<Moose::Role>, L<Class::Inspector>
 259
 260 =head1 AUTHOR
 261
 262 Guillermo Roditi, <groditi@cpan.org>
 263
 264 =head1 BUGS
 265
 266 Holler?
 267
 268 Please report any bugs or feature requests to
 269 C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
 270 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
 271 I will be notified, and then you'll automatically be notified of progress on
 272 your bug as I make changes.
 273
 274 =head1 SUPPORT
 275
 276 You can find documentation for this module with the perldoc command.
 277
 278     perldoc MooseX-Object-Pluggable
 279
 280 You can also look for information at:
 281
 282 =over 4
 283
 284 =item * AnnoCPAN: Annotated CPAN documentation
 285
 286 L<http://annocpan.org/dist/MooseX-Object-Pluggable>
 287
 288 =item * CPAN Ratings
 289
 290 L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>
 291
 292 =item * RT: CPAN's request tracker
 293
 294 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>
 295
 296 =item * Search CPAN
 297
 298 L<http://search.cpan.org/dist/MooseX-Object-Pluggable>
 299
 300 =back
 301
 302 =head1 ACKNOWLEDGEMENTS
 303
 304 =over 4
 305
 306 =item #Moose - Huge number of questions
 307
 308 =item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.
 309
 310 =item Stevan Little - EVERYTHING. Without him this would have never happened.
 311
 312 =back
 313
 314 =head1 COPYRIGHT
 315
 316 Copyright 2007 Guillermo Roditi.  All Rights Reserved.  This is
 317 free software; you may redistribute it and/or modify it under the same
 318 terms as Perl itself.
 319
 320 =cut