[gitmo/MooseX-Object-Pluggable.git] / lib / MooseX / Object / Pluggable.pm

package MooseX::Object::Pluggable;

use Carp;
use strict;
use warnings;
use Moose::Role;
use Class::Inspector;

our $VERSION = '0.0004';

=head1 NAME

    MooseX::Object::Pluggable - Make your classes pluggable

=head1 SYNOPSIS

    package MyApp;
    use Moose;
    
    with 'MooseX::Object::Pluggable';

    ...

    package MyApp::Plugin::Pretty;
    use Moose::Role;

    sub pretty{ print "I am pretty" }

    1;

    #
    use MyApp;
    my $app = MyApp->new;
    $app->load_plugin('Pretty');
    $app->pretty;

=head1 DESCRIPTION

This module is meant to be loaded as a role from Moose-based classes
it will add five methods and four attributes to assist you with the loading
and handling of plugins and extensions for plugins. I understand that this may
pollute your namespace, however I took great care in using the least ambiguous
names possible.

=head1 How plugins Work

Plugins and extensions are just Roles by a fancy name. They are loaded at runtime
on demand and are instance, not class based. This means that if you have more than
one instance of a class they can all have different plugins loaded. This is a feature.

Plugin methods are allowed to C<around>, C<before>, C<after>
their consuming classes, so it is important to watch for load order as plugins can
and will overload each other. You may also add attributes through has.

Please note that when you load at runtime you lose the ability to wrap C<BUILD>
and roles using C<has> will not go through comile time checks like C<required>
and <default>.

Even though C<override> will work , I STRONGLY discourage it's use 
and a warning will be thrown if you try to use it.
This is closely linked to the way multiple roles being applies is handles and is not
likely to change. C<override> bevavior is closely linked to inheritance and thus will
likely not work as you expect it in multiple inheritance situations. Point being,
save yourself the headache.

=head1 How plugins are loaded

When roles are applied at runtime an anonymous class will wrap your class and
C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object,
they will instead return the name of the anonymous class created at runtime.
See C<_original_class_name>.

=head1 Usage

For a simple example see the tests included in this distribution.

=head1 Attributes

=head2 _plugin_ns

String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.

=head2 _plugin_ext

Boolean. Indicates whether we should attempt to load plugin extensions.
Defaults to true;

=head2 _plugin_ext_ns

String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.

This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
"ExtensionFor" loading plugin "Bar" would search for extensions in
"MyApp::Plugin::Bar::ExtensionFor::*". 

=head2 _plugin_loaded

HashRef. Keeps an inventory of what plugins are loaded and what the actual
module name is to avoid multiple loading.

=cut

#--------#---------#---------#---------#---------#---------#---------#---------#

has _plugin_ns     => (is => 'rw', required => 1, isa => 'Str', 
                       default => 'Plugin');

has _plugin_ext    => (is => 'rw', required => 1, isa => 'Bool',
	               default => 1);
has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str', 
		       default => 'ExtensionFor');
has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef', 
		       default => sub{ {} });

#--------#---------#---------#---------#---------#---------#---------#---------#

=head1 Public Methods

=head2 load_plugin $plugin

This is the only method you should be using. Load the apropriate role for 
C<$plugin> as well as any extensions it provides if extensions are enabled.

=cut

sub load_plugin{
    my ($self, $plugin) = @_;
    die("You must provide a plugin name") unless $plugin;

    my $loaded = $self->_plugin_loaded;
    return 1 if exists $loaded->{$plugin};
 
    my $role = $self->_role_from_plugin($plugin);

    $loaded->{$plugin} = $role      if $self->_load_and_apply_role($role);
    $self->load_plugin_ext($plugin) if $self->_plugin_ext;

    return exists $loaded->{$plugin};
}


=head2 load_plugin_ext

Will load any extensions for a particular plugin. This should be called 
automatically by C<load_plugin> so you don't need to worry about it.
It basically attempts to load any extension that exists for a plugin 
that is already loaded. The only reason for using this is if you want to
keep _plugin_ext as false and only load extensions manually, which I don't
recommend.

=cut

sub load_plugin_ext{
    my ($self, $plugin) = @_;
    die("You must provide a plugin name") unless $plugin;
    my $role = $self->_role_from_plugin($plugin);

    # $p for plugin, $r for role
    while( my($p,$r) = each %{ $self->_plugin_loaded }){
	my $ext = join "::", $role, $self->_plugin_ext_ns, $p;	

	$self->_load_and_apply_role( $ext ) 
	    if Class::Inspector->installed($ext);

	#go back to prev loaded modules and load extensions for current module?
	#my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
	#$self->_load_and_apply_role( $ext2 ) 
	#    if Class::Inspector->installed($ext2);
    }
}

=head2 _original_class_name

Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
no longer return what you expect. Instead use this class to get your original
class name.

=cut

sub _original_class_name{
    my $self = shift;
    return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
}


=head1 Private Methods

There's nothing stopping you from using these, but if you are using them 
for anything thats not really complicated you are probably doing 
something wrong. Some of these may be inlined in the future if performance
becomes an issue (which I doubt).

=head2 _role_from_plugin $plugin

Creates a role name from a plugin name. If the plugin name is prepended 
with a C<+> it will be treated as a full name returned as is. Otherwise
a string consisting of C<$plugin>  prepended with the application name 
and C<_plugin_ns> will be returned. Example
   
   #assuming appname MyApp and C<_plugin_ns> 'Plugin'   
   $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin

=cut

sub _role_from_plugin{
    my ($self, $plugin) = @_;

    return $1 if $plugin =~ /^\+(.*)/;

    return join '::', ( $self->_original_class_name, 
			$self->_plugin_ns, $plugin );
}

=head2 _load_and_apply_role $role

Require C<$role> if it is not already loaded and apply it. This is
the meat of this module.

=cut

sub _load_and_apply_role{
    my ($self, $role) = @_;
    die("You must provide a role name") unless $role;

    #Throw exception if plugin is not installed
    die("$role is not available on this system") 
	unless Class::Inspector->installed($role);

    #don't re-require...
    unless( Class::Inspector->loaded($role) ){
	eval "require $role" || die("Failed to load role: $role");
    }


    carp("Using 'override' is strongly discouraged and may not behave ".
	 "as you expect it to. Please use 'around'")
	if scalar keys %{ $role->meta->get_override_method_modifiers_map };   

    #apply the plugin to the anon subclass
    die("Failed to apply plugin: $role") 
	unless $role->meta->apply( $self );

    return 1;
}

=head2 meta

Keep tests happy. See L<Moose>

=cut

1;

__END__;

=head1 SEE ALSO

L<Moose>, L<Moose::Role>, L<Class::Inspector>

=head1 AUTHOR

Guillermo Roditi, <groditi@cpan.org>

=head1 BUGS

Holler?

Please report any bugs or feature requests to
C<bug-moosex-object-pluggable at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Object-Pluggable>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc MooseX-Object-Pluggable

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/MooseX-Object-Pluggable>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/MooseX-Object-Pluggable>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Object-Pluggable>

=item * Search CPAN

L<http://search.cpan.org/dist/MooseX-Object-Pluggable>

=back

=head1 ACKNOWLEDGEMENTS

=over 4

=item #Moose - Huge number of questions

=item Matt S Trout <mst@shadowcatsystems.co.uk> - ideas / planning.

=item Stevan Little - EVERYTHING. Without him this would have never happened.

=back

=head1 COPYRIGHT

Copyright 2007 Guillermo Roditi.  All Rights Reserved.  This is
free software; you may redistribute it and/or modify it under the same
terms as Perl itself.

=cut
Commit	Line	Data
421e9f8d	1	package MooseX::Object::Pluggable;
	2
	3	use Carp;
	4	use strict;
	5	use warnings;
	6	use Moose::Role;
	7	use Class::Inspector;
	8
12d4facb	9	our $VERSION = '0.0004';
421e9f8d	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
9bef9c02	40	it will add five methods and four attributes to assist you with the loading
421e9f8d	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
06c9b714	55	Please note that when you load at runtime you lose the ability to wrap C<BUILD>
9bef9c02	56	and roles using C<has> will not go through comile time checks like C<required>
	57	and <default>.
	58
06c9b714	59	Even though C<override> will work , I STRONGLY discourage it's use
421e9f8d	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
9bef9c02	68	When roles are applied at runtime an anonymous class will wrap your class and
421e9f8d	69	C<$self-E<gt>blessed> and C<ref $self> will no longer return the name of your object,
9bef9c02	70	they will instead return the name of the anonymous class created at runtime.
9bef9c02	71	See C<_original_class_name>.
421e9f8d	72
9bef9c02	73	=head1 Usage
421e9f8d	74
9bef9c02	75	For a simple example see the tests included in this distribution.
421e9f8d	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
421e9f8d	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
421e9f8d	115	#--------#---------#---------#---------#---------#---------#---------#---------#
	116
	117	=head1 Public Methods
	118
	119	=head2 load_plugin $plugin
	120
9bef9c02	121	This is the only method you should be using. Load the apropriate role for
9bef9c02	122	C<$plugin> as well as any extensions it provides if extensions are enabled.
421e9f8d	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};
9bef9c02	132
421e9f8d	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
12d4facb	142	=head2 load_plugin_ext
421e9f8d	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
9bef9c02	172	=head2 _original_class_name
421e9f8d	173
9bef9c02	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.
421e9f8d	177
	178	=cut
	179
9bef9c02	180	sub _original_class_name{
421e9f8d	181	my $self = shift;
9bef9c02	182	return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
421e9f8d	183	}
421e9f8d	184
9bef9c02	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
421e9f8d	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
9bef9c02	208	return $1 if $plugin =~ /^\+(.*)/;
421e9f8d	209
9bef9c02	210	return join '::', ( $self->_original_class_name,
9bef9c02	211	$self->_plugin_ns, $plugin );
421e9f8d	212	}
	213
	214	=head2 _load_and_apply_role $role
	215
9bef9c02	216	Require C<$role> if it is not already loaded and apply it. This is
9bef9c02	217	the meat of this module.
421e9f8d	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
9bef9c02	234
421e9f8d	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")
9bef9c02	241	unless $role->meta->apply( $self );
421e9f8d	242
	243	return 1;
	244	}
	245
12d4facb	246	=head2 meta
	247
	248	Keep tests happy. See L<Moose>
	249
	250	=cut
	251
421e9f8d	252	1;
	253
	254	__END__;
	255
	256	=head1 SEE ALSO
	257
9bef9c02	258	L<Moose>, L<Moose::Role>, L<Class::Inspector>
421e9f8d	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