package MooseX::AbstractFactory::Role;
use strict;
use warnings;
use Moose::Role;
use Moose::Autobox;
use Class::Load qw( load_class );
use Try::Tiny;
our $VERSION = '0.004002'; # VERSION
our $AUTHORITY = 'cpan:PENFOLD';
has _options => (is => 'ro', isa => 'ArrayRef[Any]');
has _implementation => (is => 'ro', isa => 'Str');
sub create {
my ($class, $impl, @impl_args) = @_;
if (defined $impl) {
my $factory
= $class->new({
_implementation => $impl,
_options => [ @impl_args ]
});
my $iclass
= $factory->_get_implementation_class(
$factory->_implementation()
);
# pull in our implementation class
$factory->_validate_implementation_class($iclass);
my $iconstructor = $iclass->meta->constructor_name;
my $implementation
= $iclass->$iconstructor(
@{ $factory->_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) = @_;
try {
# can we load the class?
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 { 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);
}
}
}
catch {
confess "Invalid implementation class $iclass: $_";
};
return;
}
1;
# ABSTRACT: AbstractFactory behaviour as a Moose extension
__END__
=pod
=encoding UTF-8
=head1 NAME
MooseX::AbstractFactory::Role - AbstractFactory behaviour as a Moose extension
=head1 VERSION
version 0.004002
=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 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::Load::load_class() )
to be used, and (optionally) that it provides the methods defined in _roles().
This can be overridden 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 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 ACKNOWLEDGMENTS
Thanks to Matt Trout for some of the ideas for the code in
_validate_implementation_class.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website
https://github.com/fleetfootmike/MX-AbstractFactory/issues
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=head1 AUTHORS
=over 4
=item *
Mike Whitaker <mike@altrion.org>
=item *
Caleb Cushing <xenoterracide@gmail.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Mike Whitaker.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut