Commit | Line | Data |
73e9153a |
1 | package MooseCompat; |
2 | # Moose compatible methods/functions |
1c8a7125 |
3 | |
4 | use Test::Builder (); # should load Test::Builder first |
5 | |
65a61aee |
6 | use Mouse (); |
7 | use Mouse::Util::MetaRole; |
8 | use Mouse::Meta::Method; |
9 | use Mouse::Meta::Role::Method; |
10 | |
11 | $INC{'Mouse/Meta.pm'} = __FILE__; |
12 | $INC{'Mouse/Meta/Instance.pm'} = __FILE__; |
13 | $INC{'Mouse/Deprecated.pm'} = __FILE__; |
14 | |
65a61aee |
15 | *UNIVERSAL::DOES = sub { |
16 | my($thing, $role) = @_; |
17 | $thing->isa($role); |
18 | } unless UNIVERSAL->can('DOES'); |
19 | |
20 | $Mouse::Deprecated::deprecated = $Mouse::Deprecated::deprecated = undef; # -w |
21 | |
22 | package Mouse::Util; |
23 | |
24 | sub resolve_metatrait_alias { |
25 | return resolve_metaclass_alias( @_, trait => 1); |
26 | } |
27 | |
28 | sub ensure_all_roles { |
29 | my $consumer = shift; |
30 | apply_all_roles($consumer, grep { !does_role($appicant, $_) } @_); |
31 | return; |
32 | } |
73e9153a |
33 | |
34 | package Mouse::Meta::Module; |
35 | |
36 | sub version { no strict 'refs'; ${shift->name.'::VERSION'} } |
37 | sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} } |
38 | sub identifier { |
39 | my $self = shift; |
40 | return join '-' => ( |
41 | $self->name, |
42 | ($self->version || ()), |
43 | ($self->authority || ()), |
44 | ); |
45 | } |
46 | |
65a61aee |
47 | sub role_applications { } |
48 | |
73e9153a |
49 | package Mouse::Meta::Role; |
50 | |
51 | for my $modifier_type (qw/before after around/) { |
52 | my $modifier = "${modifier_type}_method_modifiers"; |
53 | my $has_method_modifiers = sub{ |
54 | my($self, $method_name) = @_; |
55 | my $m = $self->{$modifier}->{$method_name}; |
56 | return $m && @{$m} != 0; |
57 | }; |
58 | |
59 | no strict 'refs'; |
60 | *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers; |
61 | } |
62 | |
63 | |
64 | sub has_override_method_modifier { |
65 | my ($self, $method_name) = @_; |
66 | return exists $self->{override_method_modifiers}->{$method_name}; |
67 | } |
68 | |
69 | sub get_method_modifier_list { |
70 | my($self, $modifier_type) = @_; |
71 | |
72 | return keys %{ $self->{$modifier_type . '_method_modifiers'} }; |
73 | } |
74 | |
65a61aee |
75 | package Mouse::Meta::Method; |
76 | |
77 | sub get_original_method { Mouse::Meta::Method->wrap(sub { }) } |
78 | |
79 | sub associated_attribute { undef } |
80 | |
73e9153a |
81 | package Mouse::Util::TypeConstraints; |
82 | |
83 | use Mouse::Util::TypeConstraints (); |
84 | |
85 | sub export_type_constraints_as_functions { # TEST ONLY |
86 | my $into = caller; |
87 | |
88 | foreach my $type( list_all_type_constraints() ) { |
89 | my $tc = find_type_constraint($type)->_compiled_type_constraint; |
90 | my $as = $into . '::' . $type; |
91 | |
92 | no strict 'refs'; |
93 | *{$as} = sub{ &{$tc} || undef }; |
94 | } |
95 | return; |
96 | } |
97 | |
65a61aee |
98 | package Mouse::Meta::Attribute; |
73e9153a |
99 | |
100 | sub applied_traits{ $_[0]->{traits} } # TEST ONLY |
101 | sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY |
102 | |
65a61aee |
103 | sub get_raw_value { undef } # not supported |
104 | sub set_raw_value { undef } # not supported |
105 | |
106 | package Mouse::Meta::TypeConstraint; |
107 | |
108 | sub has_message { exists $_[0]->{message} } |
109 | |
110 | sub validate { |
111 | my($self, $value) = @_; |
112 | return $self->check($value) ? undef : $self->get_message($value); |
113 | } |
114 | |
115 | sub is_subtype_of { |
116 | my($self, $other) = @_; |
117 | return undef; # not supported |
118 | } |
119 | |
120 | sub equals { |
121 | my($self, $other) = @_; |
122 | return undef; # not supported |
123 | } |
124 | |
125 | sub class { undef } |
126 | sub role { undef } |
73e9153a |
127 | 1; |