lib/DBIx/Class/DeploymentHandler/WithApplicatorDumple2.pm

   1 package DBIx::Class::DeploymentHandler::WithApplicatorDumple2;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Package::Variant
   7   importing => {
   8      'Module::Runtime' => ['require_module'],
   9      'Moose::Role' => [],
  10   },
  11   subs => [qw(has require_module)];
  12
  13 sub make_variant {
  14   my ($class, $target, %args) = @_;
  15
  16   my $interface_role = $args{interface_role}
  17     or die 'interface_role is required!';
  18
  19   my $class_name = $args{class_name}
  20     or die 'class_name is required!';
  21
  22   my $delegate_name = $args{delegate_name}
  23     or die 'delegate_name is required!';
  24
  25   my $attributes_to_copy = $args{attributes_to_copy} || [];
  26   my $attributes_to_assume = $args{attributes_to_assume} || [];
  27
  28   require_module($class_name);
  29
  30   my $meta = Class::MOP::class_of($class_name);
  31
  32   has($_->name => %{ $_->clone })
  33     for grep { $_ } map $meta->find_attribute_by_name($_), @{ $attributes_to_copy };
  34
  35   has($delegate_name => (
  36     is         => 'ro',
  37     lazy_build => 1,
  38     does       => $interface_role,
  39     handles    => $interface_role,
  40   ));
  41
  42   install '_build_'.$delegate_name => sub {
  43     my $self = shift;
  44
  45     $class_name->new({
  46       map { $_ => $self->$_ }
  47         @{ $attributes_to_assume },
  48         @{ $attributes_to_copy   },
  49     })
  50   };
  51 };
  52
  53 1;
  54
  55 # vim: ts=2 sw=2 expandtab
  56
  57 __END__