lib/Method/Generate/BuildAll.pm

   1 package Method::Generate::BuildAll;
   2
   3 use strictures 1;
   4 use base qw(Moo::Object);
   5 use Sub::Quote;
   6 use Moo::_mro;
   7 use Moo::_Utils;
   8 use B 'perlstring';
   9
  10 sub generate_method {
  11   my ($self, $into) = @_;
  12   quote_sub "${into}::BUILDALL", join '',
  13     qq{    my \$self = shift;\n},
  14     qq{    my \$class = ref \$self;\n},
  15       '    if ('. perlstring($into) ." ne \$class) {\n",
  16     qq{        return \$self->\${\\(\$Moo::Object::BUILD_MAKER->generate_method(\$class))}(\@_);\n},
  17       "    } else {\n",
  18                $self->buildall_body_for($into, '$self', '@_'),
  19       "    }\n",
  20     qq{    return \$self\n};
  21 }
  22
  23 sub buildall_body_for {
  24   my ($self, $into, $me, $args) = @_;
  25   my @builds =
  26     grep *{_getglob($_)}{CODE},
  27     map "${_}::BUILD",
  28     reverse @{mro::get_linear_isa($into)};
  29   join '', map qq{        ${me}->${_}(${args});\n}, @builds;
  30 }
  31
  32 1;