fdaec572a0ad83e0a214a0f4bdd531a9749ab273
[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       _install_modifier($target, $type, @_);
37     };
38   }
39   {
40     no strict 'refs';
41     @{"${target}::ISA"} = do {
42       require Moo::Object; ('Moo::Object');
43     } unless @{"${target}::ISA"};
44   }
45 }
46
47 sub _constructor_maker_for {
48   my ($class, $target) = @_;
49   return unless $MAKERS{$target};
50   $MAKERS{$target}{constructor} ||= do {
51     require Method::Generate::Constructor;
52     Method::Generate::Constructor
53       ->new(
54         package => $target,
55         accessor_generator => do {
56           require Method::Generate::Accessor;
57           Method::Generate::Accessor->new;
58         }
59       )
60       ->install_delayed
61       ->register_attribute_specs(do {
62         my @spec;
63         # using the -last- entry in @ISA means that classes created by
64         # Role::Tiny as N roles + superclass will still get the attributes
65         # from the superclass
66         if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) {
67           if (my $con = $MAKERS{$super}{constructor}) {
68             @spec = %{$con->all_attribute_specs};
69           }
70         }
71         @spec;
72       });
73   }
74 }
75
76 1;