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