Attribute::Builder initial sketch

[scpubgit/Object-Builder.git] / lib / Attribute / Builder / AttributeSet.pm

package Attribute::Builder::AttributeSet;

use strictures 1;
use Scalar::Util qw(blessed);
use Object::Builder;
use Package::Variant
  importing => [ 'Moo::Role' ],
  subs => [ qw(has around) ];

sub make_variant {
  my ($class, $target, $name, %opts) = @_;

  my $builder_name = "${name}_builder";

  my $arguments_name = "_${name}_builder_arguments";

  my $final_arguments_name = "_final${arguments_name}";

  my $clearer = $opts{clearer}||'';

  if ($clearer eq '1') {
    $clearer = $name =~ /^_/ ? "_clear${name}" : "clear_$name";
  }

  has $arguments_name => (
    is => 'ro', init_arg => $name, default => sub { {} }
  );
      
  has $builder_name => (
    is => 'ro',
    builder => 1,
    handles => {
      $name => 'object',
      ($clearer ? ($clearer => 'clear_object') : ()),
      "${name}_class" => 'class',
      "${name}_roles" => 'roles',
    },
  );

  my %builder_opts = %{$opts{builder}||{}};

  my %builder_args = %{$builder_opts{arguments}||{}};

  $builder_args{class

  my %default_args = %{$opts{default_arguments}||{}};

  install $final_arguments_name => sub {
    my ($self) = @_;
    return { %default_args, %{$self->$arguments_name} };
  };

  install "_build_${builder_name}" => sub {
    my ($self) = @_;
    Object::Builder->new(
      class => 'Object::Builder',
      %builder_opts,
      arguments => {
        %builder_args,
        arguments => $self->$final_arguments_name
      }
    );
  };
}

1;