Commit | Line | Data |
3362e41c |
1 | package Moo::HandleMoose; |
2 | |
3 | use strictures 1; |
4 | use Moo::_Utils; |
5 | |
37de175a |
6 | our %TYPE_MAP; |
7 | |
7c418d0b |
8 | our $SETUP_DONE; |
9 | |
10 | sub import { return if $SETUP_DONE; inject_all(); $SETUP_DONE = 1; } |
3362e41c |
11 | |
12 | sub inject_all { |
13 | require Class::MOP; |
14 | inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', keys %Moo::MAKERS; |
7f9775b1 |
15 | inject_fake_metaclass_for($_) for keys %Moo::Role::INFO; |
3362e41c |
16 | } |
17 | |
18 | sub inject_fake_metaclass_for { |
19 | my ($name) = @_; |
20 | require Class::MOP; |
21 | Class::MOP::store_metaclass_by_name( |
22 | $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass') |
23 | ); |
24 | } |
25 | |
26 | our %DID_INJECT; |
27 | |
28 | sub inject_real_metaclass_for { |
29 | my ($name) = @_; |
30 | return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name}; |
31 | require Moose; require Moo; require Moo::Role; |
32 | Class::MOP::remove_metaclass_by_name($name); |
7f9775b1 |
33 | my ($am_role, $meta, $attr_specs) = do { |
3362e41c |
34 | if (my $info = $Moo::Role::INFO{$name}) { |
7f9775b1 |
35 | (1, Moose::Meta::Role->initialize($name), $info->{attributes}) |
3362e41c |
36 | } else { |
37 | my $specs = Moo->_constructor_maker_for($name)->all_attribute_specs; |
7f9775b1 |
38 | (0, Moose::Meta::Class->initialize($name), $specs); |
3362e41c |
39 | } |
40 | }; |
41 | my %methods = %{Role::Tiny->_concrete_methods_of($name)}; |
42 | my @attrs; |
43 | { |
55afe266 |
44 | # This local is completely not required for roles but harmless |
3362e41c |
45 | local @{_getstash($name)}{keys %methods}; |
46 | foreach my $name (keys %$attr_specs) { |
55afe266 |
47 | my %spec = %{$attr_specs->{$name}}; |
2bb6aaa3 |
48 | $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp'; |
f8d65713 |
49 | delete $spec{asserter}; |
37de175a |
50 | if (my $isa = $spec{isa}) { |
51 | $spec{isa} = do { |
52 | if (my $mapped = $TYPE_MAP{$isa}) { |
81cb9bab |
53 | $mapped->(); |
37de175a |
54 | } else { |
55 | Moose::Meta::TypeConstraint->new( |
56 | constraint => sub { eval { &$isa; 1 } } |
57 | ); |
58 | } |
59 | }; |
60 | } |
55afe266 |
61 | push @attrs, $meta->add_attribute($name => %spec); |
3362e41c |
62 | } |
63 | } |
55afe266 |
64 | if ($am_role) { |
146fb407 |
65 | my $info = $Moo::Role::INFO{$name}; |
66 | $meta->add_required_methods(@{$info->{requires}}); |
67 | foreach my $modifier (@{$info->{modifiers}}) { |
68 | my ($type, @args) = @$modifier; |
69 | $meta->${\"add_${type}_method_modifier"}(@args); |
70 | } |
55afe266 |
71 | } else { |
7f9775b1 |
72 | foreach my $attr (@attrs) { |
73 | foreach my $method (@{$attr->associated_methods}) { |
74 | $method->{body} = $name->can($method->name); |
75 | } |
3362e41c |
76 | } |
77 | } |
7c418d0b |
78 | $meta->add_role(Class::MOP::class_of($_)) |
79 | for keys %{$Role::Tiny::APPLIED_TO{$name}}; |
3362e41c |
80 | $DID_INJECT{$name} = 1; |
81 | $meta; |
82 | } |
83 | |
84 | { |
85 | package Moo::HandleMoose::FakeMetaClass; |
86 | |
87 | sub DESTROY { } |
88 | |
89 | sub AUTOLOAD { |
90 | my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/); |
91 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->$meth(@_) |
92 | } |
93 | sub can { |
94 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->can(@_) |
95 | } |
96 | sub isa { |
97 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->isa(@_) |
98 | } |
99 | } |
100 | |
101 | 1; |