$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 {
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;
$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,
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;