add BUILDALL support

diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 4484eca..e9f3415 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
--- 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 (file)
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;