3 files changed, 513 insertions, 0 deletions
diff --git a/lib/MooseX/AbstractFactory.pm b/lib/MooseX/AbstractFactory.pm
new file mode 100644
index 0000000..9474721
--- /dev/null
+++ b/lib/MooseX/AbstractFactory.pm
@@ -0,0 +1,202 @@
+package MooseX::AbstractFactory;
+
+use Moose ();
+use Moose::Exporter;
+use MooseX::AbstractFactory::Role;
+use MooseX::AbstractFactory::Meta::Class;
+
+our $VERSION = '0.3.2';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:PENFOLD';
+
+# syntactic sugar for various tricks
+
+Moose::Exporter->setup_import_methods(
+    with_caller => [ 'implementation_does', 'implementation_class_via' ], 
+    also => 'Moose',
+);
+
+sub implementation_does {
+    my ($caller, @roles) = @_;
+    
+    $caller->meta->implementation_roles(\@roles);
+    return;
+}
+
+sub implementation_class_via {
+    my ($caller, $code) = @_;
+    
+    $caller->meta->implementation_class_maker($code);
+    return;
+}
+
+sub init_meta {
+    my ($class, %options) = @_;
+
+    Moose->init_meta( %options, metaclass => 'MooseX::AbstractFactory::Meta::Class' );
+    
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for_class => $options{for_class},
+        roles     => ['MooseX::AbstractFactory::Role'],
+    );
+
+    return $options{for_class}->meta();
+}
+
+1;    # Magic true value required at end of module
+__END__
+
+=head1 NAME
+
+MooseX::AbstractFactory - AbstractFactory behaviour as a Moose extension
+
+
+=head1 SYNOPSIS
+
+	package My::Factory;
+	use MooseX::AbstractFactory;
+	
+	# optional role(s) that define what the implementations should implement
+
+	implementation_does qw/My::Factory::Implementation::Requires/];
+	implementation_class_via sub { 'My::Implementation::' . shift };
+	
+	# -------------------------------------------------------------
+	package My::Implementation::One;
+	use Moose;
+	
+	has connection => (is => 'ro', isa => 'Str');
+
+	sub tweak_connection {
+		...
+	}
+	
+	
+	# -------------------------------------------------------------	
+	package My::Factory::Implementation::Requires;
+	use Moose::Role;
+	requires 'tweak_connection';
+
+	
+	# -------------------------------------------------------------
+	package main;
+	use My::Factory;
+	
+	my $imp = My::Factory->create('One',
+		{ connection => 'Type1' },
+	);
+
+	
+
+=head1 DESCRIPTION
+
+Implements an AbstractFactory as a Moose extension 
+
+
+=head1 SUBROUTINES/METHODS 
+
+=head2 create()
+
+Returns an instance of the requested implementation.
+
+    use MooseX::AbstractFactory;
+    
+	my $imp = My::Factory->create(
+		'Implementation',
+		{ connection => 'Type1' },
+	);
+	
+=head2 implementation_does
+
+Syntactic sugar to define a list of roles each implementation must consume.
+
+=head2 implementation_class_via
+
+Syntactic sugar to provide a sub to generate the implementation class name:
+e.g.:
+
+    use MooseX::AbstractFactory;
+    implementation_class_via sub { 'My::Implementation::' . shift };
+
+and then
+
+    my $imp = My::Factory->create("ClassA");
+    
+    # $imp->isa "My::Implementation::ClassA"
+    
+The default behaviour is to prepend the factory class name, so in the above
+example (without the implementation_class_via) the implementation class would 
+be "My::Factory::ClassA".
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item C<< No implementation provided >>
+
+If the factory class's new() method doesn't get an implementation passed, 
+then it will die with the above error.
+
+=item C<< Invalid implementation class %s: %s" >>
+
+The implementation passed to the factory class mapped to a class that doesn't exist.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+ 
+MooseX::AbstractFactory requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+Moose.
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported. Yet.
+
+Please report any bugs or feature requests to C<mike@altrion.org>, or via RT.
+
+
+=head1 AUTHOR
+
+Mike Whitaker  C<< <mike@altrion.org> >>
+
+With thanks to Dave Rolsky for the suggestions for syntactic sugar.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007-8, Mike Whitaker C<< <mike@altrion.org> >>.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
diff --git a/lib/MooseX/AbstractFactory/Meta/Class.pm b/lib/MooseX/AbstractFactory/Meta/Class.pm
new file mode 100644
index 0000000..9fbd4a4
--- /dev/null
+++ b/lib/MooseX/AbstractFactory/Meta/Class.pm
@@ -0,0 +1,108 @@
+package MooseX::AbstractFactory::Meta::Class;
+use Moose;
+extends 'Moose::Meta::Class';
+
+our $VERSION = '0.3.2';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:PENFOLD';
+
+has implementation_roles => (
+    isa => 'ArrayRef',
+    is => 'rw',
+    predicate => 'has_implementation_roles',
+);
+
+has implementation_class_maker => (
+    isa => 'CodeRef',
+    is => 'rw',
+    predicate => 'has_class_maker',
+);
+1;
+__END__
+
+=head1 NAME
+
+MooseX::AbstractFactory::Meta::Class - Meta class for MooseX::AbstractFactory
+
+=head1 SYNOPSIS
+
+You shouldn't be using this on its own, but via MooseX::AbstractFactory
+
+=head1 DESCRIPTION
+
+Metaclass to implement an AbstractFactory as a Moose extension.
+
+=head1 SUBROUTINES/METHODS 
+
+=head2 implementation_roles
+
+Roles each implementation class must satisfy.
+
+=head2 has_implementation_roles
+
+Predicate for above
+
+=head2 implementation_class_maker
+
+Coderef to generate a full class from a tag in the factory create() method.
+
+=head2 has_class_maker
+
+Predicate for above
+
+=head1 CONFIGURATION AND ENVIRONMENT
+ 
+MooseX::AbstractFactory requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+Moose.
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported. Yet.
+
+Please report any bugs or feature requests to C<mike@altrion.org>, or via RT.
+
+
+=head1 AUTHOR
+
+Mike Whitaker  C<< <mike@altrion.org> >>
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007-8, Mike Whitaker C<< <mike@altrion.org> >>.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
diff --git a/lib/MooseX/AbstractFactory/Role.pm b/lib/MooseX/AbstractFactory/Role.pm
new file mode 100644
index 0000000..d560ca9
--- /dev/null
+++ b/lib/MooseX/AbstractFactory/Role.pm
@@ -0,0 +1,203 @@
+package MooseX::AbstractFactory::Role;
+
+use Moose::Autobox;
+use Moose::Role;
+
+our $VERSION = '0.3.2';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:PENFOLD';
+
+has _options        => (is => 'ro', isa => 'HashRef');
+has _implementation => (is => 'ro', isa => 'Str');
+
+sub create {
+    my ($class, $impl, $args) = @_;
+
+    my $factory = $class->new(_implementation => $impl, _options => $args);
+
+    my $i = $factory->_implementation();
+
+    if (defined $impl) {
+        my $iclass = $factory->_get_implementation_class($i);
+        # pull in our implementation class
+        $factory->_validate_implementation_class($iclass);
+
+        eval "use $iclass";
+
+        my $options = $factory->_options();
+
+        my $implementation = $iclass->new($options);
+        # TODO - should we sneak a factory attr onto the metaclass?
+        return $implementation;
+    }
+    else {
+        confess('No implementation provided');
+    }
+}
+
+sub _get_implementation_class {
+    my ($self, $impl) = @_;
+
+    my $class = blessed $self;
+    if ($self->meta->has_class_maker) {
+        return $self->meta->implementation_class_maker->($impl);
+    } 
+    else {
+        return $class . "::$impl";
+    }
+}
+
+sub _validate_implementation_class {
+    my ($self, $iclass) = @_;
+
+    eval {
+        # can we load the class?
+        Class::MOP->load_class($iclass);    # may die if user really stuffed up _get_implementation_class()
+
+        if ($self->meta->has_implementation_roles) {
+            my $roles = $self->meta->implementation_roles();
+
+            # create an anon class that's a subclass of it
+            my $anon = Moose::Meta::Class->create_anon_class();
+
+            # make it a subclass of the implementation
+            $anon->superclasses($iclass);
+
+            # Lifted from MooseX::Recipe::Builder->_build_anon_meta()
+
+            # load our role classes
+            $roles->map( sub { Class::MOP::load_class($_); } );
+
+            # apply roles to anon class
+            if (scalar @{$roles} == 1) {
+                $roles->[0]->meta->apply($anon);
+            }
+            else {
+                Moose::Meta::Role->combine($roles->map(sub { $_->meta; } ))->apply($anon);
+            }
+        }
+    };
+    confess "Invalid implementation class $iclass: $@" if $@;
+
+    return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+MooseX::AbstractFactory::Role - AbstractFactory behaviour as a Moose extension
+
+=head1 SYNOPSIS
+
+You shouldn't be using this on its own, but via MooseX::AbstractFactory
+
+=head1 DESCRIPTION
+
+Role to implement an AbstractFactory as a Moose extension.
+
+
+=head1 SUBROUTINES/METHODS 
+
+=head2 create()
+
+Returns an instance of the requested implementation.
+
+    use MooseX::AbstractFactory;
+    
+	my $imp = My::Factory->create(
+		'Implementation',
+		{ connection => 'Type1' },
+	);
+	
+=head2 _validate_implementation_class()
+
+Checks that the implementation class exists (via Class::MOP->load_class() ) 
+to be used, and (optionally) that it provides the methods defined in _roles().
+
+This can be overriden by a factory class definition if required: for example
+
+	sub _validate_implementation_class {
+		my $self = shift;
+		return 1; # all implementation classes are valid :)
+	}
+
+
+=head2 _get_implementation_class()
+
+By default, the factory figures out the class of the implementation requested 
+by prepending the factory class itself, so for example
+
+	my $imp = My::Factory->new(
+		implementation => 'Implementation')
+		
+will return an object of class My::Factory::Implementation.
+
+This can be overridden in the factory class by redefining the
+_get_implementation_class() method, for example:
+	
+	sub _get_implementation_class {
+		my ($self, $class) = @_;
+		return "My::ImplementationClasses::$class";
+	}
+
+=head1 CONFIGURATION AND ENVIRONMENT
+ 
+MooseX::AbstractFactory requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+Moose, and Moose::Autobox
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported. Yet.
+
+Please report any bugs or feature requests to C<mike@altrion.org>, or via RT.
+
+
+=head1 AUTHOR
+
+Mike Whitaker  C<< <mike@altrion.org> >>
+
+With thanks to Matt Trout for some of the ideas for the code in
+_validate_implementation_class.
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007-8, Mike Whitaker C<< <mike@altrion.org> >>.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.