From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 15 Sep 2014 15:50:11 +0000 (+0000)
Subject: Attribute::Builder initial sketch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fmaster;p=scpubgit%2FObject-Builder.git

Attribute::Builder initial sketch
---

diff --git a/lib/Attribute/Builder/AttributeSet.pm b/lib/Attribute/Builder/AttributeSet.pm
new file mode 100644
index 0000000..2bfe7be
--- /dev/null
+++ b/lib/Attribute/Builder/AttributeSet.pm
@@ -0,0 +1,66 @@
+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;