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