From: Matt S Trout Date: Mon, 8 Nov 2010 01:24:23 +0000 (+0000) Subject: add BUILDALL support X-Git-Tag: 0.009001~55 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=098a367be3b5fed11db98bef906ae31303fee5d3;p=gitmo%2FRole-Tiny.git add BUILDALL support --- diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm index 4484eca..e9f3415 100644 --- a/lib/Class/Tiny.pm +++ b/lib/Class/Tiny.pm @@ -56,7 +56,10 @@ sub _constructor_maker_for { ->install_delayed ->register_attribute_specs(do { my @spec; - if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[0] }) { + # using the -last- entry in @ISA means that classes created by + # Role::Tiny as N roles + superclass will still get the attributes + # from the superclass + if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) { if (my $con = $MAKERS{$super}{constructor}) { @spec = %{$con->all_attribute_specs}; } diff --git a/lib/Class/Tiny/Object.pm b/lib/Class/Tiny/Object.pm index e3e31c7..bf19053 100644 --- a/lib/Class/Tiny/Object.pm +++ b/lib/Class/Tiny/Object.pm @@ -2,9 +2,25 @@ package Class::Tiny::Object; use strictures 1; +our %NO_BUILD; +our $BUILD_MAKER; + sub new { my $class = shift; - bless({ @_ }, $class); + $NO_BUILD{$class} and + return bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class); + $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; +} + +sub BUILDALL { + my $self = shift; + $self->${\(($BUILD_MAKER ||= do { + require Method::Generate::BuildAll; + Method::Generate::BuildAll->new + })->generate_method(ref($self)))}(@_); } sub does { diff --git a/lib/Class/Tiny/_mro.pm b/lib/Class/Tiny/_mro.pm new file mode 100644 index 0000000..f957d71 --- /dev/null +++ b/lib/Class/Tiny/_mro.pm @@ -0,0 +1,9 @@ +package Class::Tiny::_mro; + +if ($] > 5.010) { + require mro; +} else { + require MRO::Compat; +} + +1; diff --git a/lib/Method/Generate/BuildAll.pm b/lib/Method/Generate/BuildAll.pm new file mode 100644 index 0000000..b7895b8 --- /dev/null +++ b/lib/Method/Generate/BuildAll.pm @@ -0,0 +1,21 @@ +package Method::Generate::BuildAll; + +use strictures 1; +use base qw(Class::Tiny::Object); +use Sub::Quote; +use Class::Tiny::_mro; +use Class::Tiny::_Utils; + +sub generate_method { + my ($self, $into) = @_; + 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}; +} + +1; diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm index 27f0213..d06775f 100644 --- a/lib/Role/Tiny.pm +++ b/lib/Role/Tiny.pm @@ -85,12 +85,7 @@ sub create_class_with_roles { die "${role} is not a Role::Tiny" unless my $info = $INFO{$role}; } - if ($] > 5.010) { - require mro; - } else { - require MRO::Compat; - } - + require Class::Tiny::_mro; require Sub::Quote; my @composable = map $me->_composable_package_for($_), reverse @roles; diff --git a/t/buildall.t b/t/buildall.t new file mode 100644 index 0000000..f27fbc1 --- /dev/null +++ b/t/buildall.t @@ -0,0 +1,18 @@ +use strictures 1; +use Test::More; + +my @ran; + +{ + package Foo; use Class::Tiny; sub BUILD { push @ran, 'Foo' } + package Bar; use Class::Tiny; extends 'Foo'; sub BUILD { push @ran, 'Bar' } + package Baz; use Class::Tiny; extends 'Bar'; + package Quux; use Class::Tiny; extends 'Baz'; sub BUILD { push @ran, 'Quux' } +} + +my $o = Quux->new; + +is(ref($o), 'Quux', 'object returned'); +is_deeply(\@ran, [ qw(Foo Bar Quux) ], 'BUILDs ran in order'); + +done_testing;