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