Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/darwin-thread-multi-2level/Mouse/Meta/Role.pm |
Statements | Executed 6 statements in 885µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 15µs | 65µs | BEGIN@2 | Mouse::Meta::Role::
1 | 1 | 1 | 5µs | 5µs | BEGIN@4 | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | _construct_meta | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_attribute | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_override_method_modifier | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | add_required_methods | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | apply | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | calculate_all_roles | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | combine | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | create_anon_role | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | does_role | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | get_override_method_modifier | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | get_required_method_list | Mouse::Meta::Role::
0 | 0 | 0 | 0s | 0s | requires_method | Mouse::Meta::Role::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Mouse::Meta::Role; | ||||
2 | 2 | 36µs | 2 | 114µs | # spent 65µs (15+50) within Mouse::Meta::Role::BEGIN@2 which was called:
# once (15µs+50µs) by Mouse::BEGIN@15 at line 2 # spent 65µs making 1 call to Mouse::Meta::Role::BEGIN@2
# spent 50µs making 1 call to Mouse::Exporter::do_import |
3 | |||||
4 | 2 | 838µs | 1 | 5µs | # spent 5µs within Mouse::Meta::Role::BEGIN@4 which was called:
# once (5µs+0s) by Mouse::BEGIN@15 at line 4 # spent 5µs making 1 call to Mouse::Meta::Role::BEGIN@4 |
5 | 1 | 7µs | our @ISA = qw(Mouse::Meta::Module); | ||
6 | |||||
7 | sub method_metaclass; | ||||
8 | |||||
9 | sub _construct_meta { | ||||
10 | my $class = shift; | ||||
11 | |||||
12 | my %args = @_; | ||||
13 | |||||
14 | $args{methods} = {}; | ||||
15 | $args{attributes} = {}; | ||||
16 | $args{required_methods} = []; | ||||
17 | $args{roles} = []; | ||||
18 | |||||
19 | my $self = bless \%args, ref($class) || $class; | ||||
20 | if($class ne __PACKAGE__){ | ||||
21 | $self->meta->_initialize_object($self, \%args); | ||||
22 | } | ||||
23 | return $self; | ||||
24 | } | ||||
25 | |||||
26 | sub create_anon_role{ | ||||
27 | my $self = shift; | ||||
28 | return $self->create(undef, @_); | ||||
29 | } | ||||
30 | |||||
31 | sub is_anon_role; | ||||
32 | |||||
33 | sub get_roles; | ||||
34 | |||||
35 | sub calculate_all_roles { | ||||
36 | my $self = shift; | ||||
37 | my %seen; | ||||
38 | return grep { !$seen{ $_->name }++ } | ||||
39 | ($self, map { $_->calculate_all_roles } @{ $self->get_roles }); | ||||
40 | } | ||||
41 | |||||
42 | sub get_required_method_list{ | ||||
43 | return @{ $_[0]->{required_methods} }; | ||||
44 | } | ||||
45 | |||||
46 | sub add_required_methods { | ||||
47 | my($self, @methods) = @_; | ||||
48 | my %required = map{ $_ => 1 } @{$self->{required_methods}}; | ||||
49 | push @{$self->{required_methods}}, grep{ !$required{$_}++ && !$self->has_method($_) } @methods; | ||||
50 | return; | ||||
51 | } | ||||
52 | |||||
53 | sub requires_method { | ||||
54 | my($self, $name) = @_; | ||||
55 | return scalar( grep{ $_ eq $name } @{ $self->{required_methods} } ) != 0; | ||||
56 | } | ||||
57 | |||||
58 | sub add_attribute { | ||||
59 | my $self = shift; | ||||
60 | my $name = shift; | ||||
61 | |||||
62 | $self->{attributes}->{$name} = (@_ == 1) ? $_[0] : { @_ }; | ||||
63 | return; | ||||
64 | } | ||||
65 | |||||
66 | sub apply { | ||||
67 | my $self = shift; | ||||
68 | my $consumer = shift; | ||||
69 | |||||
70 | require 'Mouse/Meta/Role/Application.pm'; | ||||
71 | return Mouse::Meta::Role::Application->new(@_)->apply($self, $consumer); | ||||
72 | } | ||||
73 | |||||
74 | sub combine { | ||||
75 | my($self, @role_specs) = @_; | ||||
76 | |||||
77 | require 'Mouse/Meta/Role/Composite.pm'; | ||||
78 | return Mouse::Meta::Role::Composite->new(roles => \@role_specs); | ||||
79 | } | ||||
80 | |||||
81 | sub add_before_method_modifier; | ||||
82 | sub add_around_method_modifier; | ||||
83 | sub add_after_method_modifier; | ||||
84 | |||||
85 | sub get_before_method_modifiers; | ||||
86 | sub get_around_method_modifiers; | ||||
87 | sub get_after_method_modifiers; | ||||
88 | |||||
89 | sub add_override_method_modifier{ | ||||
90 | my($self, $method_name, $method) = @_; | ||||
91 | |||||
92 | if($self->has_method($method_name)){ | ||||
93 | # This error happens in the override keyword or during role composition, | ||||
94 | # so I added a message, "A local method of ...", only for compatibility (gfx) | ||||
95 | $self->throw_error("Cannot add an override of method '$method_name' " | ||||
96 | . "because there is a local version of '$method_name'" | ||||
97 | . "(A local method of the same name as been found)"); | ||||
98 | } | ||||
99 | |||||
100 | $self->{override_method_modifiers}->{$method_name} = $method; | ||||
101 | } | ||||
102 | |||||
103 | sub get_override_method_modifier { | ||||
104 | my ($self, $method_name) = @_; | ||||
105 | return $self->{override_method_modifiers}->{$method_name}; | ||||
106 | } | ||||
107 | |||||
108 | sub does_role { | ||||
109 | my ($self, $role_name) = @_; | ||||
110 | |||||
111 | (defined $role_name) | ||||
112 | || $self->throw_error("You must supply a role name to look for"); | ||||
113 | |||||
114 | $role_name = $role_name->name if ref $role_name; | ||||
115 | |||||
116 | # if we are it,.. then return true | ||||
117 | return 1 if $role_name eq $self->name; | ||||
118 | # otherwise.. check our children | ||||
119 | for my $role (@{ $self->get_roles }) { | ||||
120 | return 1 if $role->does_role($role_name); | ||||
121 | } | ||||
122 | return 0; | ||||
123 | } | ||||
124 | |||||
125 | 1 | 4µs | 1; | ||
126 | __END__ |