1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
use Moo::_strictures;
use Test::More;
use Moo::_mro;
BEGIN {
package Class::Diminutive;
sub new {
my $class = shift;
my $args = $class->BUILDARGS(@_);
my $no_build = delete $args->{__no_BUILD__};
my $self = bless { %$args }, $class;
$self->BUILDALL
unless $no_build;
return $self;
}
sub BUILDARGS {
my $class = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
return \%args;
}
sub BUILDALL {
my $self = shift;
my $class = ref $self;
my @builds =
grep { defined }
map {; no strict 'refs'; *{$_.'::BUILD'}{CODE} }
@{mro::get_linear_isa($class)};
for my $build (@builds) {
$self->$build;
}
}
}
BEGIN {
package TestClass1;
our @ISA = ('Class::Diminutive');
sub BUILD {
$_[0]->{build_called}++;
}
sub BUILDARGS {
my $class = shift;
my $args = $class->SUPER::BUILDARGS(@_);
$args->{no_build_used} = $args->{__no_BUILD__};
return $args;
}
}
my $o = TestClass1->new;
is $o->{build_called}, 1, 'mini class builder working';
BEGIN {
package TestClass2;
use Moo;
extends 'TestClass1';
}
my $o2 = TestClass2->new;
is $o2->{build_called}, 1, 'BUILD still called when extending mini class builder';
is $o2->{no_build_used}, 1, '__no_BUILD__ was passed to mini builder';
my $o3 = TestClass2->new({__no_BUILD__ => 1});
is $o3->{build_called}, undef, '__no_BUILD__ inhibits Moo calling BUILD';
done_testing;
|
