Commit | Line | Data |
3a63a2e7 |
1 | package Mouse::Meta::Module; |
2 | use strict; |
3 | use warnings; |
4 | |
5 | use Scalar::Util qw/blessed weaken/; |
6 | use Mouse::Util qw/version authority identifier get_code_info/; |
7 | use Carp 'confess'; |
8 | |
9 | sub name { $_[0]->{package} } |
10 | sub _method_map{ $_[0]->{methods} } |
11 | |
12 | sub namespace{ |
13 | my $name = $_[0]->{package}; |
14 | no strict 'refs'; |
15 | return \%{ $name . '::' }; |
16 | } |
17 | |
18 | sub add_method { |
19 | my($self, $name, $code) = @_; |
20 | |
21 | if(!defined $name){ |
22 | confess "You must pass a defined name"; |
23 | } |
24 | if(ref($code) ne 'CODE'){ |
25 | confess "You must pass a CODE reference"; |
26 | } |
27 | |
28 | $self->_method_map->{$name}++; # Moose stores meta object here. |
29 | |
30 | my $pkg = $self->name; |
31 | no strict 'refs'; |
32 | no warnings 'redefine'; |
33 | *{ $pkg . '::' . $name } = $code; |
34 | } |
35 | |
36 | sub _code_is_mine { # taken from Class::MOP::Class\r |
37 | my ( $self, $code ) = @_;\r |
38 | \r |
39 | my ( $code_package, $code_name ) = get_code_info($code);\r |
40 | \r |
41 | return $code_package && $code_package eq $self->name\r |
42 | || ( $code_package eq 'constant' && $code_name eq '__ANON__' );\r |
43 | } |
44 | |
45 | sub has_method { |
46 | my($self, $method_name) = @_; |
47 | |
48 | return 1 if $self->_method_map->{$method_name}; |
49 | my $code = $self->name->can($method_name); |
50 | |
51 | return $code && $self->_code_is_mine($code); |
52 | } |
53 | |
54 | |
55 | |
56 | sub get_method_list {\r |
57 | my($self) = @_; |
58 | \r |
59 | return grep { $self->has_method($_) } keys %{ $self->namespace };\r |
60 | } |
61 | |
62 | sub get_attribute_map { $_[0]->{attributes} } |
63 | sub has_attribute { exists $_[0]->{attributes}->{$_[1]} } |
64 | sub get_attribute { $_[0]->{attributes}->{$_[1]} } |
65 | sub get_attribute_list { |
66 | my $self = shift; |
67 | keys %{$self->get_attribute_map}; |
68 | } |
69 | |
70 | |
71 | 1; |
72 | |
73 | __END__ |
74 | |
75 | =head1 NAME |
76 | |
77 | Mouse::Meta::Module - Common base class for Mouse::Meta::Class and Mouse::Meta::Role |
78 | |
79 | =cut |