lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple.pm

   1 package DBIx::Class::DeploymentHandler::WithApplicatorDumple;
   2 use MooseX::Role::Parameterized;
   3 use Class::MOP;
   4 use namespace::autoclean;
   5
   6 # this is at least a little ghetto and not super well
   7 # thought out.  Take a look at the following at some
   8 # point to clean it all up:
   9 #
  10 # http://search.cpan.org/~jjnapiork/MooseX-Role-BuildInstanceOf-0.06/lib/MooseX/Role/BuildInstanceOf.pm
  11 # http://github.com/rjbs/role-subsystem/blob/master/lib/Role/Subsystem.pm
  12
  13 parameter interface_role => (
  14   isa      => 'Str',
  15   required => 1,
  16 );
  17
  18 parameter class_name => (
  19   isa      => 'Str',
  20   required => 1,
  21 );
  22
  23 parameter delegate_name => (
  24   isa      => 'Str',
  25   required => 1,
  26 );
  27
  28 parameter attributes_to_copy => (
  29   isa => 'ArrayRef[Str]',
  30   default => sub {[]},
  31 );
  32
  33 parameter attributes_to_assume => (
  34   isa => 'ArrayRef[Str]',
  35   default => sub {[]},
  36 );
  37
  38 role {
  39   my $p = shift;
  40
  41   my $class_name = $p->class_name;
  42
  43   Class::MOP::load_class($class_name);
  44
  45   my $meta = Class::MOP::class_of($class_name);
  46
  47   has $_->name => %{ $_->clone }
  48     for grep { $_ } map $meta->find_attribute_by_name($_), @{ $p->attributes_to_copy };
  49
  50   has $p->delegate_name => (
  51     is         => 'ro',
  52     lazy_build => 1,
  53     does       => $p->interface_role,
  54     handles    => $p->interface_role,
  55   );
  56
  57   method '_build_'.$p->delegate_name => sub {
  58     my $self = shift;
  59
  60     $class_name->new({
  61       map { $_ => $self->$_ }
  62         @{ $p->attributes_to_assume },
  63         @{ $p->attributes_to_copy   },
  64     })
  65   };
  66 };
  67
  68 1;
  69
  70 # vim: ts=2 sw=2 expandtab
  71
  72 __END__