BUILDALL for generated constructor
Matt S Trout [Mon, 8 Nov 2010 01:37:39 +0000 (01:37 +0000)]
lib/Class/Tiny/Object.pm
lib/Method/Generate/BuildAll.pm
lib/Method/Generate/Constructor.pm
t/buildall.t

index bf19053..8243116 100644 (file)
@@ -12,7 +12,10 @@ sub new {
   $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
   $NO_BUILD{$class}
     ? bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class)
-    : bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class)->BUILDALL;
+    : do {
+       my $proto = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
+       bless({ %$proto }, $class)->BUILDALL($proto);
+      };
 }
 
 sub BUILDALL {
index b7895b8..3b4b363 100644 (file)
@@ -8,14 +8,19 @@ use Class::Tiny::_Utils;
 
 sub generate_method {
   my ($self, $into) = @_;
+  quote_sub "${into}::BUILDALL", join '',
+    qq{    my \$self = shift;\n},
+    $self->buildall_body_for($into, '$self', '@_'),
+    qq{    return \$self\n};
+}
+
+sub buildall_body_for {
+  my ($self, $into, $me, $args) = @_;
   my @builds =
     grep *{_getglob($_)}{CODE},
     map "${_}::BUILD",
     reverse @{mro::get_linear_isa($into)};
-  quote_sub "${into}::BUILDALL", join '',
-    qq{    my \$self = shift;\n},
-    (map qq{    \$self->${_}(\@_);\n}, @builds),
-    qq{    return \$self\n};
+  join '', map qq{    ${me}->${_}(${args});\n}, @builds;
 }
 
 1;
index d62545d..0064eac 100644 (file)
@@ -44,6 +44,12 @@ sub generate_method {
   $body .= '    my $new = bless({}, $class);'."\n";
   $body .= $self->_assign_new($spec);
   $body .= $self->_fire_triggers($spec);
+  if ($into->can('BUILD')) {
+    require Method::Generate::BuildAll;
+    $body .= Method::Generate::BuildAll->new->buildall_body_for(
+      $into, '$new', '$args'
+    );
+  }
   $body .= '    return $new;'."\n";
   quote_sub
     "${into}::${name}" => $body,
index f27fbc1..7e4b953 100644 (file)
@@ -10,9 +10,24 @@ my @ran;
   package Quux; use Class::Tiny; extends 'Baz'; sub BUILD { push @ran, 'Quux' }
 }
 
+{
+  package Fleem;
+  use Class::Tiny;
+  extends 'Quux';
+  has 'foo' => (is => 'ro');
+  sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} }
+}
+
 my $o = Quux->new;
 
 is(ref($o), 'Quux', 'object returned');
 is_deeply(\@ran, [ qw(Foo Bar Quux) ], 'BUILDs ran in order');
 
+@ran = ();
+
+$o = Fleem->new(foo => 'Fleem1', bar => 'Fleem2');
+
+is(ref($o), 'Fleem', 'object with inline constructor returned');
+is_deeply(\@ran, [ qw(Foo Bar Quux Fleem1 Fleem2) ], 'BUILDs ran in order');
+
 done_testing;