lib/Moo.pm

   1 package Moo;
   2
   3 use strictures 1;
   4 use Moo::_Utils;
   5
   6 our %MAKERS;
   7
   8 sub import {
   9   my $target = caller;
  10   my $class = shift;
  11   strictures->import;
  12   *{_getglob("${target}::extends")} = sub {
  13     _load_module($_) for @_;
  14     *{_getglob("${target}::ISA")} = \@_;
  15   };
  16   *{_getglob("${target}::with")} = sub {
  17     require Moo::Role;
  18     die "Only one role supported at a time by with" if @_ > 1;
  19     Moo::Role->apply_role_to_package($_[0], $target);
  20   };
  21   $MAKERS{$target} = {};
  22   *{_getglob("${target}::has")} = sub {
  23     my ($name, %spec) = @_;
  24     ($MAKERS{$target}{accessor} ||= do {
  25       require Method::Generate::Accessor;
  26       Method::Generate::Accessor->new
  27     })->generate_method($target, $name, \%spec);
  28     $class->_constructor_maker_for($target)
  29           ->register_attribute_specs($name, \%spec);
  30   };
  31   foreach my $type (qw(before after around)) {
  32     *{_getglob "${target}::${type}"} = sub {
  33       _install_modifier($target, $type, @_);
  34     };
  35   }
  36   {
  37     no strict 'refs';
  38     @{"${target}::ISA"} = do {
  39       require Moo::Object; ('Moo::Object');
  40     } unless @{"${target}::ISA"};
  41   }
  42 }
  43
  44 sub _constructor_maker_for {
  45   my ($class, $target) = @_;
  46   return unless $MAKERS{$target};
  47   $MAKERS{$target}{constructor} ||= do {
  48     require Method::Generate::Constructor;
  49     Method::Generate::Constructor
  50       ->new(
  51         package => $target,
  52         accessor_generator => do {
  53           require Method::Generate::Accessor;
  54           Method::Generate::Accessor->new;
  55         }
  56       )
  57       ->install_delayed
  58       ->register_attribute_specs(do {
  59         my @spec;
  60         # using the -last- entry in @ISA means that classes created by
  61         # Role::Tiny as N roles + superclass will still get the attributes
  62         # from the superclass
  63         if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) {
  64           if (my $con = $MAKERS{$super}{constructor}) {
  65             @spec = %{$con->all_attribute_specs};
  66           }
  67         }
  68         @spec;
  69       });
  70   }
  71 }
  72
  73 1;