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