lib/Attribute/Builder/AttributeSet.pm

   1 package Attribute::Builder::AttributeSet;
   2
   3 use strictures 1;
   4 use Scalar::Util qw(blessed);
   5 use Object::Builder;
   6 use Package::Variant
   7   importing => [ 'Moo::Role' ],
   8   subs => [ qw(has around) ];
   9
  10 sub make_variant {
  11   my ($class, $target, $name, %opts) = @_;
  12
  13   my $builder_name = "${name}_builder";
  14
  15   my $arguments_name = "_${name}_builder_arguments";
  16
  17   my $final_arguments_name = "_final${arguments_name}";
  18
  19   my $clearer = $opts{clearer}||'';
  20
  21   if ($clearer eq '1') {
  22     $clearer = $name =~ /^_/ ? "_clear${name}" : "clear_$name";
  23   }
  24
  25   has $arguments_name => (
  26     is => 'ro', init_arg => $name, default => sub { {} }
  27   );
  28
  29   has $builder_name => (
  30     is => 'ro',
  31     builder => 1,
  32     handles => {
  33       $name => 'object',
  34       ($clearer ? ($clearer => 'clear_object') : ()),
  35       "${name}_class" => 'class',
  36       "${name}_roles" => 'roles',
  37     },
  38   );
  39
  40   my %builder_opts = %{$opts{builder}||{}};
  41
  42   my %builder_args = %{$builder_opts{arguments}||{}};
  43
  44   $builder_args{class
  45
  46   my %default_args = %{$opts{default_arguments}||{}};
  47
  48   install $final_arguments_name => sub {
  49     my ($self) = @_;
  50     return { %default_args, %{$self->$arguments_name} };
  51   };
  52
  53   install "_build_${builder_name}" => sub {
  54     my ($self) = @_;
  55     Object::Builder->new(
  56       class => 'Object::Builder',
  57       %builder_opts,
  58       arguments => {
  59         %builder_args,
  60         arguments => $self->$final_arguments_name
  61       }
  62     );
  63   };
  64 }
  65
  66 1;