1package DBIx::Class::DeploymentHandler::WithApplicatorDumple; 2$DBIx::Class::DeploymentHandler::WithApplicatorDumple::VERSION = '0.002230'; 3use Moo::Role; 4use MooX::Role::Parameterized; 5use Module::Runtime 'use_module'; 6use DBIx::Class::DeploymentHandler::Types -all; 7 8# this is at least a little ghetto and not super well 9# thought out. Take a look at the following at some 10# point to clean it all up: 11# 12# http://search.cpan.org/~jjnapiork/MooseX-Role-BuildInstanceOf-0.06/lib/MooseX/Role/BuildInstanceOf.pm 13# http://github.com/rjbs/role-subsystem/blob/master/lib/Role/Subsystem.pm 14 15role { 16 my $p = shift; 17 my $mop = shift; 18 19 my $class_name = Str->($p->{class_name}) or die; 20 my $delegate_name = Str->($p->{delegate_name}) or die; 21 my $interface_role = Str->($p->{interface_role}) or die; 22 my $attributes_to_assume = (Maybe[ArrayRef[Str]])->($p->{attributes_to_assume}) || []; 23 my $attributes_to_copy = (Maybe[ArrayRef[Str]])->($p->{attributes_to_copy}) || []; 24 25 use_module($class_name); 26 27 my $meta = Moo->_constructor_maker_for($class_name); 28 my $class_attrs = $meta->all_attribute_specs; 29 30 $mop->has($_ => %{ $class_attrs->{$_} }) 31 for grep $class_attrs->{$_}, @$attributes_to_copy; 32 33 $mop->has($delegate_name => ( 34 is => 'lazy', 35 does => $interface_role, 36 handles => $interface_role, 37 )); 38 39 $mop->method('_build_'.$delegate_name => sub { 40 my $self = shift; 41 42 $class_name->new({ 43 map { $_ => $self->$_ } 44 @$attributes_to_assume, 45 @$attributes_to_copy, 46 }) 47 }); 48}; 49 501; 51 52# vim: ts=2 sw=2 expandtab 53 54__END__ 55