Commit | Line | Data |
3362e41c |
1 | package Moo::HandleMoose; |
2 | |
3 | use strictures 1; |
4 | use Moo::_Utils; |
5 | |
6 | sub import { inject_all() } |
7 | |
8 | sub inject_all { |
9 | require Class::MOP; |
10 | inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', keys %Moo::MAKERS; |
7f9775b1 |
11 | inject_fake_metaclass_for($_) for keys %Moo::Role::INFO; |
3362e41c |
12 | } |
13 | |
14 | sub inject_fake_metaclass_for { |
15 | my ($name) = @_; |
16 | require Class::MOP; |
17 | Class::MOP::store_metaclass_by_name( |
18 | $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass') |
19 | ); |
20 | } |
21 | |
22 | our %DID_INJECT; |
23 | |
24 | sub inject_real_metaclass_for { |
25 | my ($name) = @_; |
26 | return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name}; |
27 | require Moose; require Moo; require Moo::Role; |
28 | Class::MOP::remove_metaclass_by_name($name); |
7f9775b1 |
29 | my ($am_role, $meta, $attr_specs) = do { |
3362e41c |
30 | if (my $info = $Moo::Role::INFO{$name}) { |
7f9775b1 |
31 | (1, Moose::Meta::Role->initialize($name), $info->{attributes}) |
3362e41c |
32 | } else { |
33 | my $specs = Moo->_constructor_maker_for($name)->all_attribute_specs; |
7f9775b1 |
34 | (0, Moose::Meta::Class->initialize($name), $specs); |
3362e41c |
35 | } |
36 | }; |
37 | my %methods = %{Role::Tiny->_concrete_methods_of($name)}; |
38 | my @attrs; |
39 | { |
40 | local @{_getstash($name)}{keys %methods}; |
41 | foreach my $name (keys %$attr_specs) { |
42 | push @attrs, $meta->add_attribute($name => %{$attr_specs->{$name}}); |
43 | } |
44 | } |
7f9775b1 |
45 | unless ($am_role) { |
46 | foreach my $attr (@attrs) { |
47 | foreach my $method (@{$attr->associated_methods}) { |
48 | $method->{body} = $name->can($method->name); |
49 | } |
3362e41c |
50 | } |
51 | } |
52 | $DID_INJECT{$name} = 1; |
53 | $meta; |
54 | } |
55 | |
56 | { |
57 | package Moo::HandleMoose::FakeMetaClass; |
58 | |
59 | sub DESTROY { } |
60 | |
61 | sub AUTOLOAD { |
62 | my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/); |
63 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->$meth(@_) |
64 | } |
65 | sub can { |
66 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->can(@_) |
67 | } |
68 | sub isa { |
69 | Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->isa(@_) |
70 | } |
71 | } |
72 | |
73 | 1; |