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