Profile of /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Package.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:21 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Package.pm
Statements Executed | 5535
Statement Execution Time | 8.62ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
487 | 3 | 2 | 3.02ms | 4.74ms | Class::MOP::Package::::get_package_symbolClass::MOP::Package::get_package_symbol
498 | 4 | 4 | 2.91ms | 2.92ms | Class::MOP::Package::::add_package_symbolClass::MOP::Package::add_package_symbol
494 | 3 | 2 | 883µs | 883µs | Class::MOP::Package::::namespaceClass::MOP::Package::namespace
1381 | 19 | 9 | 801µs | 801µs | Class::MOP::Package::::nameClass::MOP::Package::name (xsub)
2 | 1 | 1 | 45µs | 84µs | Class::MOP::Package::::initializeClass::MOP::Package::initialize
4 | 1 | 1 | 44µs | 71µs | Class::MOP::Package::::has_package_symbolClass::MOP::Package::has_package_symbol
2 | 1 | 1 | 34µs | 34µs | Class::MOP::Package::::_newClass::MOP::Package::_new
1 | 1 | 1 | 28µs | 32µs | Class::MOP::Package::::BEGIN@4Class::MOP::Package::BEGIN@4
8 | 2 | 1 | 27µs | 27µs | Class::MOP::Package::::_deconstruct_variable_nameClass::MOP::Package::_deconstruct_variable_name
1 | 1 | 1 | 11µs | 23µs | Class::MOP::Package::::BEGIN@207Class::MOP::Package::BEGIN@207
1 | 1 | 1 | 11µs | 122µs | Class::MOP::Package::::BEGIN@14Class::MOP::Package::BEGIN@14
1 | 1 | 1 | 10µs | 22µs | Class::MOP::Package::::BEGIN@5Class::MOP::Package::BEGIN@5
1 | 1 | 1 | 9µs | 29µs | Class::MOP::Package::::BEGIN@100Class::MOP::Package::BEGIN@100
1 | 1 | 1 | 9µs | 31µs | Class::MOP::Package::::BEGIN@146Class::MOP::Package::BEGIN@146
1 | 1 | 1 | 9µs | 47µs | Class::MOP::Package::::BEGIN@7Class::MOP::Package::BEGIN@7
1 | 1 | 1 | 8µs | 37µs | Class::MOP::Package::::BEGIN@8Class::MOP::Package::BEGIN@8
1 | 1 | 1 | 8µs | 20µs | Class::MOP::Package::::BEGIN@145Class::MOP::Package::BEGIN@145
1 | 1 | 1 | 8µs | 20µs | Class::MOP::Package::::BEGIN@152Class::MOP::Package::BEGIN@152
0 | 0 | 0 | 0s | 0s | Class::MOP::Package::::list_all_package_symbolsClass::MOP::Package::list_all_package_symbols
0 | 0 | 0 | 0s | 0s | Class::MOP::Package::::reinitializeClass::MOP::Package::reinitialize
0 | 0 | 0 | 0s | 0s | Class::MOP::Package::::remove_package_globClass::MOP::Package::remove_package_glob
0 | 0 | 0 | 0s | 0s | Class::MOP::Package::::remove_package_symbolClass::MOP::Package::remove_package_symbol

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  |
2 |  |  |  |  | package Class::MOP::Package;
3 |  |  |  |  |
4 | 3 | 34µs | 2 | 37µs | # spent 32µs (28+5) within Class::MOP::Package::BEGIN@4 which was called # once (28µs+5µs) by base::import at line 4 use strict; # spent 32µs making 1 call to Class::MOP::Package::BEGIN@4 # spent 5µs making 1 call to strict::import
5 | 3 | 43µs | 2 | 34µs | # spent 22µs (10+12) within Class::MOP::Package::BEGIN@5 which was called # once (10µs+12µs) by base::import at line 5 use warnings; # spent 22µs making 1 call to Class::MOP::Package::BEGIN@5 # spent 12µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 3 | 30µs | 2 | 86µs | # spent 47µs (9+39) within Class::MOP::Package::BEGIN@7 which was called # once (9µs+39µs) by base::import at line 7 use Scalar::Util 'blessed', 'reftype'; # spent 47µs making 1 call to Class::MOP::Package::BEGIN@7 # spent 39µs making 1 call to Exporter::import
8 | 3 | 75µs | 2 | 65µs | # spent 37µs (8+28) within Class::MOP::Package::BEGIN@8 which was called # once (8µs+28µs) by base::import at line 8 use Carp 'confess'; # spent 37µs making 1 call to Class::MOP::Package::BEGIN@8 # spent 28µs making 1 call to Exporter::import
9 |  |  |  |  |
10 | 1 | 900ns |  |  | our $VERSION = '0.98';
11 | 1 | 19µs |  |  | $VERSION = eval $VERSION;
12 | 1 | 400ns |  |  | our $AUTHORITY = 'cpan:STEVAN';
13 |  |  |  |  |
14 | 3 | 341µs | 2 | 122µs | # spent 122µs (11+111) within Class::MOP::Package::BEGIN@14 which was called # once (11µs+111µs) by base::import at line 14 use base 'Class::MOP::Object', 'Class::MOP::Mixin::HasMethods'; # spent 122µs making 1 call to Class::MOP::Package::BEGIN@14 # spent 111µs making 1 call to base::import, recursion: max depth 2, time 111µs
15 |  |  |  |  |
16 |  |  |  |  | # creation ...
17 |  |  |  |  |
18 |  |  |  |  | # spent 84µs (45+40) within Class::MOP::Package::initialize which was called 2 times, avg 42µs/call: # 2 times (45µs+40µs) by Moose::Exporter::build_import_methods at line 79 of Moose/Exporter.pm, avg 42µs/call sub initialize {
19 | 2 | 3µs |  |  | my ( $class, @args ) = @_;
20 |  |  |  |  |
21 | 2 | 4µs |  |  | unshift @args, "package" if @args % 2;
22 |  |  |  |  |
23 | 2 | 2µs |  |  | my %options = @args;
24 | 2 | 2µs |  |  | my $package_name = $options{package};
25 |  |  |  |  |
26 |  |  |  |  |
27 |  |  |  |  | # we hand-construct the class
28 |  |  |  |  | # until we can bootstrap it
29 | 2 | 3µs | 2 | 3µs | if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) { # spent 3µs making 2 calls to Class::MOP::get_metaclass_by_name, avg 2µs/call
30 |  |  |  |  | return $meta;
31 |  |  |  |  | } else {
32 | 2 | 11µs | 2 | 34µs | my $meta = ( ref $class || $class )->_new({ # spent 34µs making 2 calls to Class::MOP::Package::_new, avg 17µs/call
33 |  |  |  |  | 'package' => $package_name,
34 |  |  |  |  | %options,
35 |  |  |  |  | });
36 | 2 | 3µs | 2 | 3µs | Class::MOP::store_metaclass_by_name($package_name, $meta); # spent 3µs making 2 calls to Class::MOP::store_metaclass_by_name, avg 1µs/call
37 |  |  |  |  |
38 | 2 | 8µs |  |  | return $meta;
39 |  |  |  |  | }
40 |  |  |  |  | }
41 |  |  |  |  |
42 |  |  |  |  | sub reinitialize {
43 |  |  |  |  | my ( $class, @args ) = @_;
44 |  |  |  |  |
45 |  |  |  |  | unshift @args, "package" if @args % 2;
46 |  |  |  |  |
47 |  |  |  |  | my %options = @args;
48 |  |  |  |  | my $package_name = delete $options{package};
49 |  |  |  |  |
50 |  |  |  |  | (defined $package_name && $package_name
51 |  |  |  |  | && (!blessed $package_name || $package_name->isa('Class::MOP::Package')))
52 |  |  |  |  | || confess "You must pass a package name or an existing Class::MOP::Package instance";
53 |  |  |  |  |
54 |  |  |  |  | $package_name = $package_name->name
55 |  |  |  |  | if blessed $package_name;
56 |  |  |  |  |
57 |  |  |  |  | Class::MOP::remove_metaclass_by_name($package_name);
58 |  |  |  |  |
59 |  |  |  |  | $class->initialize($package_name, %options); # call with first arg form for compat
60 |  |  |  |  | }
61 |  |  |  |  |
62 |  |  |  |  | # spent 34µs within Class::MOP::Package::_new which was called 2 times, avg 17µs/call: # 2 times (34µs+0s) by Class::MOP::Package::initialize at line 32, avg 17µs/call sub _new {
63 | 2 | 2µs |  |  | my $class = shift;
64 |  |  |  |  |
65 | 2 | 1µs |  |  | return Class::MOP::Class->initialize($class)->new_object(@_)
66 |  |  |  |  | if $class ne __PACKAGE__;
67 |  |  |  |  |
68 | 2 | 2µs |  |  | my $params = @_ == 1 ? $_[0] : {@_};
69 |  |  |  |  |
70 | 2 | 32µs |  |  | return bless {
71 |  |  |  |  | package => $params->{package},
72 |  |  |  |  |
73 |  |  |  |  | # NOTE:
74 |  |  |  |  | # because of issues with the Perl API
75 |  |  |  |  | # to the typeglob in some versions, we
76 |  |  |  |  | # need to just always grab a new
77 |  |  |  |  | # reference to the hash in the accessor.
78 |  |  |  |  | # Ideally we could just store a ref and
79 |  |  |  |  | # it would Just Work, but oh well :\
80 |  |  |  |  |
81 |  |  |  |  | namespace => \undef,
82 |  |  |  |  |
83 |  |  |  |  | } => $class;
84 |  |  |  |  | }
85 |  |  |  |  |
86 |  |  |  |  | # Attributes
87 |  |  |  |  |
88 |  |  |  |  | # NOTE:
89 |  |  |  |  | # all these attribute readers will be bootstrapped
90 |  |  |  |  | # away in the Class::MOP bootstrap section
91 |  |  |  |  |
92 |  |  |  |  | # spent 883µs within Class::MOP::Package::namespace which was called 494 times, avg 2µs/call: # 487 times (868µs+0s) by Class::MOP::Package::get_package_symbol at line 194, avg 2µs/call # 4 times (8µs+0s) by Class::MOP::Package::has_package_symbol at line 166, avg 2µs/call # 3 times (7µs+0s) by Class::MOP::Mixin::HasMethods::get_method_list at line 151 of Class/MOP/Mixin/HasMethods.pm, avg 2µs/call sub namespace {
93 |  |  |  |  | # NOTE:
94 |  |  |  |  | # because of issues with the Perl API
95 |  |  |  |  | # to the typeglob in some versions, we
96 |  |  |  |  | # need to just always grab a new
97 |  |  |  |  | # reference to the hash here. Ideally
98 |  |  |  |  | # we could just store a ref and it would
99 |  |  |  |  | # Just Work, but oh well :\
100 | 3 | 185µs | 2 | 49µs | # spent 29µs (9+20) within Class::MOP::Package::BEGIN@100 which was called # once (9µs+20µs) by base::import at line 100 no strict 'refs'; # spent 29µs making 1 call to Class::MOP::Package::BEGIN@100 # spent 20µs making 1 call to strict::unimport
101 | 494 | 1.36ms |  |  | \%{$_[0]->{'package'} . '::'}
102 |  |  |  |  | }
103 |  |  |  |  |
104 |  |  |  |  | # utility methods
105 |  |  |  |  |
106 |  |  |  |  | {
107 | 2 | 4µs |  |  | my %SIGIL_MAP = (
108 |  |  |  |  | '$' => 'SCALAR',
109 |  |  |  |  | '@' => 'ARRAY',
110 |  |  |  |  | '%' => 'HASH',
111 |  |  |  |  | '&' => 'CODE',
112 |  |  |  |  | );
113 |  |  |  |  |
114 |  |  |  |  | # spent 27µs within Class::MOP::Package::_deconstruct_variable_name which was called 8 times, avg 3µs/call: # 4 times (17µs+0s) by Class::MOP::Package::has_package_symbol at line 163, avg 4µs/call # 4 times (9µs+0s) by Class::MOP::Package::add_package_symbol at line 140, avg 2µs/call sub _deconstruct_variable_name {
115 | 8 | 3µs |  |  | my ($self, $variable) = @_;
116 |  |  |  |  |
117 | 8 | 1µs |  |  | (defined $variable)
118 |  |  |  |  | || confess "You must pass a variable name";
119 |  |  |  |  |
120 | 8 | 5µs |  |  | my $sigil = substr($variable, 0, 1, '');
121 |  |  |  |  |
122 | 8 | 400ns |  |  | (defined $sigil)
123 |  |  |  |  | || confess "The variable name must include a sigil";
124 |  |  |  |  |
125 | 8 | 2µs |  |  | (exists $SIGIL_MAP{$sigil})
126 |  |  |  |  | || confess "I do not recognize that sigil '$sigil'";
127 |  |  |  |  |
128 | 8 | 21µs |  |  | return ($variable, $sigil, $SIGIL_MAP{$sigil});
129 |  |  |  |  | }
130 |  |  |  |  | }
131 |  |  |  |  |
132 |  |  |  |  | # Class attributes
133 |  |  |  |  |
134 |  |  |  |  | # ... these functions have to touch the symbol table itself,.. yuk
135 |  |  |  |  |
136 |  |  |  |  | # spent 2.92ms (2.91+9µs) within Class::MOP::Package::add_package_symbol which was called 498 times, avg 6µs/call: # 351 times (2.20ms+0s) by Class::MOP::Mixin::HasMethods::add_method at line 70 of Class/MOP/Mixin/HasMethods.pm, avg 6µs/call # 131 times (628µs+0s) by Class::MOP::Package::get_package_symbol at line 197, avg 5µs/call # 12 times (55µs+0s) by Class::MOP::Class:::around at line 89 of Class/MOP/Class/Immutable/Trait.pm, avg 5µs/call # 4 times (27µs+9µs) by Moose::Exporter::build_import_methods at line 85 of Moose/Exporter.pm, avg 9µs/call sub add_package_symbol {
137 | 498 | 211µs |  |  | my ($self, $variable, $initial_value) = @_;
138 |  |  |  |  |
139 |  |  |  |  | my ($name, $sigil, $type) = ref $variable eq 'HASH'
140 | 498 | 536µs | 4 | 9µs | ? @{$variable}{qw[name sigil type]} # spent 9µs making 4 calls to Class::MOP::Package::_deconstruct_variable_name, avg 2µs/call
141 |  |  |  |  | : $self->_deconstruct_variable_name($variable);
142 |  |  |  |  |
143 | 498 | 168µs |  |  | my $pkg = $self->{'package'};
144 |  |  |  |  |
145 | 3 | 28µs | 2 | 33µs | # spent 20µs (8+12) within Class::MOP::Package::BEGIN@145 which was called # once (8µs+12µs) by base::import at line 145 no strict 'refs'; # spent 20µs making 1 call to Class::MOP::Package::BEGIN@145 # spent 12µs making 1 call to strict::unimport
146 | 3 | 75µs | 2 | 52µs | # spent 31µs (9+22) within Class::MOP::Package::BEGIN@146 which was called # once (9µs+22µs) by base::import at line 146 no warnings 'redefine', 'misc', 'prototype'; # spent 31µs making 1 call to Class::MOP::Package::BEGIN@146 # spent 22µs making 1 call to warnings::unimport
147 | 498 | 2.20ms |  |  | *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
148 |  |  |  |  | }
149 |  |  |  |  |
150 |  |  |  |  | sub remove_package_glob {
151 |  |  |  |  | my ($self, $name) = @_;
152 | 3 | 236µs | 2 | 31µs | # spent 20µs (8+12) within Class::MOP::Package::BEGIN@152 which was called # once (8µs+12µs) by base::import at line 152 no strict 'refs'; # spent 20µs making 1 call to Class::MOP::Package::BEGIN@152 # spent 12µs making 1 call to strict::unimport
153 |  |  |  |  | delete ${$self->name . '::'}{$name};
154 |  |  |  |  | }
155 |  |  |  |  |
156 |  |  |  |  | # ... these functions deal with stuff on the namespace level
157 |  |  |  |  |
158 |  |  |  |  | # spent 71µs (44+27) within Class::MOP::Package::has_package_symbol which was called 4 times, avg 18µs/call: # 4 times (44µs+27µs) by Moose::Exporter::build_import_methods at line 83 of Moose/Exporter.pm, avg 18µs/call sub has_package_symbol {
159 | 4 | 3µs |  |  | my ( $self, $variable ) = @_;
160 |  |  |  |  |
161 |  |  |  |  | my ( $name, $sigil, $type )
162 |  |  |  |  | = ref $variable eq 'HASH'
163 | 4 | 12µs | 4 | 17µs | ? @{$variable}{qw[name sigil type]} # spent 17µs making 4 calls to Class::MOP::Package::_deconstruct_variable_name, avg 4µs/call
164 |  |  |  |  | : $self->_deconstruct_variable_name($variable);
165 |  |  |  |  |
166 | 4 | 6µs | 4 | 8µs | my $namespace = $self->namespace; # spent 8µs making 4 calls to Class::MOP::Package::namespace, avg 2µs/call
167 |  |  |  |  |
168 | 4 | 8µs |  |  | return 0 unless exists $namespace->{$name};
169 |  |  |  |  |
170 | 1 | 600ns |  |  | my $entry_ref = \$namespace->{$name};
171 | 1 | 5µs | 1 | 2µs | if ( reftype($entry_ref) eq 'GLOB' ) { # spent 2µs making 1 call to Scalar::Util::reftype
172 |  |  |  |  | if ( $type eq 'SCALAR' ) {
173 |  |  |  |  | return defined( ${ *{$entry_ref}{SCALAR} } );
174 |  |  |  |  | }
175 |  |  |  |  | else {
176 | 1 | 11µs |  |  | return defined( *{$entry_ref}{$type} );
177 |  |  |  |  | }
178 |  |  |  |  | }
179 |  |  |  |  | else {
180 |  |  |  |  |
181 |  |  |  |  | # a symbol table entry can be -1 (stub), string (stub with prototype),
182 |  |  |  |  | # or reference (constant)
183 |  |  |  |  | return $type eq 'CODE';
184 |  |  |  |  | }
185 |  |  |  |  | }
186 |  |  |  |  |
187 |  |  |  |  | # spent 4.74ms (3.02+1.72) within Class::MOP::Package::get_package_symbol which was called 487 times, avg 10µs/call: # 477 times (2.94ms+1.68ms) by Class::MOP::Mixin::HasMethods::get_method at line 101 of Class/MOP/Mixin/HasMethods.pm, avg 10µs/call # 7 times (53µs+25µs) by Class::MOP::Class::superclasses at line 582 of Class/MOP/Class.pm, avg 11µs/call # 3 times (32µs+18µs) by Class::MOP::Class::superclasses at line 563 of Class/MOP/Class.pm, avg 17µs/call sub get_package_symbol {
188 | 487 | 125µs |  |  | my ($self, $variable) = @_;
189 |  |  |  |  |
190 |  |  |  |  | my ($name, $sigil, $type) = ref $variable eq 'HASH'
191 | 487 | 441µs |  |  | ? @{$variable}{qw[name sigil type]}
192 |  |  |  |  | : $self->_deconstruct_variable_name($variable);
193 |  |  |  |  |
194 | 487 | 366µs | 487 | 868µs | my $namespace = $self->namespace; # spent 868µs making 487 calls to Class::MOP::Package::namespace, avg 2µs/call
195 |  |  |  |  |
196 |  |  |  |  | # FIXME
197 | 487 | 295µs | 143 | 850µs | $self->add_package_symbol($variable) # spent 628µs making 131 calls to Class::MOP::Package::add_package_symbol, avg 5µs/call # spent 222µs making 12 calls to Class::MOP::Class::Immutable::Class::MOP::Class::add_package_symbol, avg 19µs/call
198 |  |  |  |  | unless exists $namespace->{$name};
199 |  |  |  |  |
200 | 487 | 158µs |  |  | my $entry_ref = \$namespace->{$name};
201 |  |  |  |  |
202 | 487 | 1.07ms |  |  | if ( ref($entry_ref) eq 'GLOB' ) {
203 |  |  |  |  | return *{$entry_ref}{$type};
204 |  |  |  |  | }
205 |  |  |  |  | else {
206 |  |  |  |  | if ( $type eq 'CODE' ) {
207 | 3 | 456µs | 2 | 35µs | # spent 23µs (11+12) within Class::MOP::Package::BEGIN@207 which was called # once (11µs+12µs) by base::import at line 207 no strict 'refs'; # spent 23µs making 1 call to Class::MOP::Package::BEGIN@207 # spent 12µs making 1 call to strict::unimport
208 |  |  |  |  | return \&{ $self->name . '::' . $name };
209 |  |  |  |  | }
210 |  |  |  |  | else {
211 |  |  |  |  | return undef;
212 |  |  |  |  | }
213 |  |  |  |  | }
214 |  |  |  |  | }
215 |  |  |  |  |
216 |  |  |  |  | sub remove_package_symbol {
217 |  |  |  |  | my ($self, $variable) = @_;
218 |  |  |  |  |
219 |  |  |  |  | my ($name, $sigil, $type) = ref $variable eq 'HASH'
220 |  |  |  |  | ? @{$variable}{qw[name sigil type]}
221 |  |  |  |  | : $self->_deconstruct_variable_name($variable);
222 |  |  |  |  |
223 |  |  |  |  | # FIXME:
224 |  |  |  |  | # no doubt this is grossly inefficient and
225 |  |  |  |  | # could be done much easier and faster in XS
226 |  |  |  |  |
227 |  |  |  |  | my ($scalar_desc, $array_desc, $hash_desc, $code_desc) = (
228 |  |  |  |  | { sigil => '$', type => 'SCALAR', name => $name },
229 |  |  |  |  | { sigil => '@', type => 'ARRAY', name => $name },
230 |  |  |  |  | { sigil => '%', type => 'HASH', name => $name },
231 |  |  |  |  | { sigil => '&', type => 'CODE', name => $name },
232 |  |  |  |  | );
233 |  |  |  |  |
234 |  |  |  |  | my ($scalar, $array, $hash, $code);
235 |  |  |  |  | if ($type eq 'SCALAR') {
236 |  |  |  |  | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
237 |  |  |  |  | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
238 |  |  |  |  | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
239 |  |  |  |  | }
240 |  |  |  |  | elsif ($type eq 'ARRAY') {
241 |  |  |  |  | $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
242 |  |  |  |  | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
243 |  |  |  |  | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
244 |  |  |  |  | }
245 |  |  |  |  | elsif ($type eq 'HASH') {
246 |  |  |  |  | $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
247 |  |  |  |  | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
248 |  |  |  |  | $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
249 |  |  |  |  | }
250 |  |  |  |  | elsif ($type eq 'CODE') {
251 |  |  |  |  | $scalar = $self->get_package_symbol($scalar_desc) if $self->has_package_symbol($scalar_desc);
252 |  |  |  |  | $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
253 |  |  |  |  | $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
254 |  |  |  |  | }
255 |  |  |  |  | else {
256 |  |  |  |  | confess "This should never ever ever happen";
257 |  |  |  |  | }
258 |  |  |  |  |
259 |  |  |  |  | $self->remove_package_glob($name);
260 |  |  |  |  |
261 |  |  |  |  | $self->add_package_symbol($scalar_desc => $scalar) if defined $scalar;
262 |  |  |  |  | $self->add_package_symbol($array_desc => $array) if defined $array;
263 |  |  |  |  | $self->add_package_symbol($hash_desc => $hash) if defined $hash;
264 |  |  |  |  | $self->add_package_symbol($code_desc => $code) if defined $code;
265 |  |  |  |  | }
266 |  |  |  |  |
267 |  |  |  |  | sub list_all_package_symbols {
268 |  |  |  |  | my ($self, $type_filter) = @_;
269 |  |  |  |  |
270 |  |  |  |  | my $namespace = $self->namespace;
271 |  |  |  |  | return keys %{$namespace} unless defined $type_filter;
272 |  |  |  |  |
273 |  |  |  |  | # NOTE:
274 |  |  |  |  | # or we can filter based on
275 |  |  |  |  | # type (SCALAR|ARRAY|HASH|CODE)
276 |  |  |  |  | if ( $type_filter eq 'CODE' ) {
277 |  |  |  |  | return grep {
278 |  |  |  |  | (ref($namespace->{$_})
279 |  |  |  |  | ? (ref($namespace->{$_}) eq 'SCALAR')
280 |  |  |  |  | : (ref(\$namespace->{$_}) eq 'GLOB'
281 |  |  |  |  | && defined(*{$namespace->{$_}}{CODE})));
282 |  |  |  |  | } keys %{$namespace};
283 |  |  |  |  | } else {
284 |  |  |  |  | return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
285 |  |  |  |  | }
286 |  |  |  |  | }
287 |  |  |  |  |
288 | 1 | 13µs |  |  | 1;
289 |  |  |  |  |
290 |  |  |  |  | __END__
291 |  |  |  |  |
292 |  |  |  |  | =pod
293 |  |  |  |  |
294 |  |  |  |  | =head1 NAME
295 |  |  |  |  |
296 |  |  |  |  | Class::MOP::Package - Package Meta Object
297 |  |  |  |  |
298 |  |  |  |  | =head1 DESCRIPTION
299 |  |  |  |  |
300 |  |  |  |  | The Package Protocol provides an abstraction of a Perl 5 package. A
301 |  |  |  |  | package is basically namespace, and this module provides methods for
302 |  |  |  |  | looking at and changing that namespace's symbol table.
303 |  |  |  |  |
304 |  |  |  |  | =head1 METHODS
305 |  |  |  |  |
306 |  |  |  |  | =over 4
307 |  |  |  |  |
308 |  |  |  |  | =item B<< Class::MOP::Package->initialize($package_name) >>
309 |  |  |  |  |
310 |  |  |  |  | This method creates a new C<Class::MOP::Package> instance which
311 |  |  |  |  | represents specified package. If an existing metaclass object exists
312 |  |  |  |  | for the package, that will be returned instead.
313 |  |  |  |  |
314 |  |  |  |  | =item B<< Class::MOP::Package->reinitialize($package) >>
315 |  |  |  |  |
316 |  |  |  |  | This method forcibly removes any existing metaclass for the package
317 |  |  |  |  | before calling C<initialize>. In contrast to C<initialize>, you may
318 |  |  |  |  | also pass an existing C<Class::MOP::Package> instance instead of just
319 |  |  |  |  | a package name as C<$package>.
320 |  |  |  |  |
321 |  |  |  |  | Do not call this unless you know what you are doing.
322 |  |  |  |  |
323 |  |  |  |  | =item B<< $metapackage->name >>
324 |  |  |  |  |
325 |  |  |  |  | This is returns the package's name, as passed to the constructor.
326 |  |  |  |  |
327 |  |  |  |  | =item B<< $metapackage->namespace >>
328 |  |  |  |  |
329 |  |  |  |  | This returns a hash reference to the package's symbol table. The keys
330 |  |  |  |  | are symbol names and the values are typeglob references.
331 |  |  |  |  |
332 |  |  |  |  | =item B<< $metapackage->add_package_symbol($variable_name, $initial_value) >>
333 |  |  |  |  |
334 |  |  |  |  | This method accepts a variable name and an optional initial value. The
335 |  |  |  |  | C<$variable_name> must contain a leading sigil.
336 |  |  |  |  |
337 |  |  |  |  | This method creates the variable in the package's symbol table, and
338 |  |  |  |  | sets it to the initial value if one was provided.
339 |  |  |  |  |
340 |  |  |  |  | =item B<< $metapackage->get_package_symbol($variable_name) >>
341 |  |  |  |  |
342 |  |  |  |  | Given a variable name, this method returns the variable as a reference
343 |  |  |  |  | or undef if it does not exist. The C<$variable_name> must contain a
344 |  |  |  |  | leading sigil.
345 |  |  |  |  |
346 |  |  |  |  | =item B<< $metapackage->has_package_symbol($variable_name) >>
347 |  |  |  |  |
348 |  |  |  |  | Returns true if there is a package variable defined for
349 |  |  |  |  | C<$variable_name>. The C<$variable_name> must contain a leading sigil.
350 |  |  |  |  |
351 |  |  |  |  | =item B<< $metapackage->remove_package_symbol($variable_name) >>
352 |  |  |  |  |
353 |  |  |  |  | This will remove the package variable specified C<$variable_name>. The
354 |  |  |  |  | C<$variable_name> must contain a leading sigil.
355 |  |  |  |  |
356 |  |  |  |  | =item B<< $metapackage->remove_package_glob($glob_name) >>
357 |  |  |  |  |
358 |  |  |  |  | Given the name of a glob, this will remove that glob from the
359 |  |  |  |  | package's symbol table. Glob names do not include a sigil. Removing
360 |  |  |  |  | the glob removes all variables and subroutines with the specified
361 |  |  |  |  | name.
362 |  |  |  |  |
363 |  |  |  |  | =item B<< $metapackage->list_all_package_symbols($type_filter) >>
364 |  |  |  |  |
365 |  |  |  |  | This will list all the glob names associated with the current
366 |  |  |  |  | package. These names do not have leading sigils.
367 |  |  |  |  |
368 |  |  |  |  | You can provide an optional type filter, which should be one of
369 |  |  |  |  | 'SCALAR', 'ARRAY', 'HASH', or 'CODE'.
370 |  |  |  |  |
371 |  |  |  |  | =item B<< $metapackage->get_all_package_symbols($type_filter) >>
372 |  |  |  |  |
373 |  |  |  |  | This works much like C<list_all_package_symbols>, but it returns a
374 |  |  |  |  | hash reference. The keys are glob names and the values are references
375 |  |  |  |  | to the value for that name.
376 |  |  |  |  |
377 |  |  |  |  | =back
378 |  |  |  |  |
379 |  |  |  |  | =head2 Method introspection and creation
380 |  |  |  |  |
381 |  |  |  |  | These methods allow you to introspect a class's methods, as well as
382 |  |  |  |  | add, remove, or change methods.
383 |  |  |  |  |
384 |  |  |  |  | Determining what is truly a method in a Perl 5 class requires some
385 |  |  |  |  | heuristics (aka guessing).
386 |  |  |  |  |
387 |  |  |  |  | Methods defined outside the package with a fully qualified name (C<sub
388 |  |  |  |  | Package::name { ... }>) will be included. Similarly, methods named
389 |  |  |  |  | with a fully qualified name using L<Sub::Name> are also included.
390 |  |  |  |  |
391 |  |  |  |  | However, we attempt to ignore imported functions.
392 |  |  |  |  |
393 |  |  |  |  | Ultimately, we are using heuristics to determine what truly is a
394 |  |  |  |  | method in a class, and these heuristics may get the wrong answer in
395 |  |  |  |  | some edge cases. However, for most "normal" cases the heuristics work
396 |  |  |  |  | correctly.
397 |  |  |  |  |
398 |  |  |  |  | =over 4
399 |  |  |  |  |
400 |  |  |  |  | =item B<< $metapackage->get_method($method_name) >>
401 |  |  |  |  |
402 |  |  |  |  | This will return a L<Class::MOP::Method> for the specified
403 |  |  |  |  | C<$method_name>. If the class does not have the specified method, it
404 |  |  |  |  | returns C<undef>
405 |  |  |  |  |
406 |  |  |  |  | =item B<< $metapackage->has_method($method_name) >>
407 |  |  |  |  |
408 |  |  |  |  | Returns a boolean indicating whether or not the class defines the
409 |  |  |  |  | named method. It does not include methods inherited from parent
410 |  |  |  |  | classes.
411 |  |  |  |  |
412 |  |  |  |  | =item B<< $metapackage->get_method_list >>
413 |  |  |  |  |
414 |  |  |  |  | This will return a list of method I<names> for all methods defined in
415 |  |  |  |  | this class.
416 |  |  |  |  |
417 |  |  |  |  | =item B<< $metapackage->add_method($method_name, $method) >>
418 |  |  |  |  |
419 |  |  |  |  | This method takes a method name and a subroutine reference, and adds
420 |  |  |  |  | the method to the class.
421 |  |  |  |  |
422 |  |  |  |  | The subroutine reference can be a L<Class::MOP::Method>, and you are
423 |  |  |  |  | strongly encouraged to pass a meta method object instead of a code
424 |  |  |  |  | reference. If you do so, that object gets stored as part of the
425 |  |  |  |  | class's method map directly. If not, the meta information will have to
426 |  |  |  |  | be recreated later, and may be incorrect.
427 |  |  |  |  |
428 |  |  |  |  | If you provide a method object, this method will clone that object if
429 |  |  |  |  | the object's package name does not match the class name. This lets us
430 |  |  |  |  | track the original source of any methods added from other classes
431 |  |  |  |  | (notably Moose roles).
432 |  |  |  |  |
433 |  |  |  |  | =item B<< $metapackage->remove_method($method_name) >>
434 |  |  |  |  |
435 |  |  |  |  | Remove the named method from the class. This method returns the
436 |  |  |  |  | L<Class::MOP::Method> object for the method.
437 |  |  |  |  |
438 |  |  |  |  | =item B<< $metapackage->method_metaclass >>
439 |  |  |  |  |
440 |  |  |  |  | Returns the class name of the method metaclass, see
441 |  |  |  |  | L<Class::MOP::Method> for more information on the method metaclass.
442 |  |  |  |  |
443 |  |  |  |  | =item B<< $metapackage->wrapped_method_metaclass >>
444 |  |  |  |  |
445 |  |  |  |  | Returns the class name of the wrapped method metaclass, see
446 |  |  |  |  | L<Class::MOP::Method::Wrapped> for more information on the wrapped
447 |  |  |  |  | method metaclass.
448 |  |  |  |  |
449 |  |  |  |  | =item B<< Class::MOP::Package->meta >>
450 |  |  |  |  |
451 |  |  |  |  | This will return a L<Class::MOP::Class> instance for this class.
452 |  |  |  |  |
453 |  |  |  |  | =back
454 |  |  |  |  |
455 |  |  |  |  | =head1 AUTHORS
456 |  |  |  |  |
457 |  |  |  |  | Stevan Little E<lt>stevan@iinteractive.comE<gt>
458 |  |  |  |  |
459 |  |  |  |  | =head1 COPYRIGHT AND LICENSE
460 |  |  |  |  |
461 |  |  |  |  | Copyright 2006-2010 by Infinity Interactive, Inc.
462 |  |  |  |  |
463 |  |  |  |  | L<http://www.iinteractive.com>
464 |  |  |  |  |
465 |  |  |  |  | This library is free software; you can redistribute it and/or modify
466 |  |  |  |  | it under the same terms as Perl itself.
467 |  |  |  |  |
468 |  |  |  |  | =cut
|  |  |  |  | # spent 801µs within Class::MOP::Package::name which was called 1381 times, avg 580ns/call: # 310 times (142µs+0s) by Class::MOP::Mixin::HasMethods::add_method at line 45 of Class/MOP/Mixin/HasMethods.pm, avg 459ns/call # 288 times (188µs+0s) by Class::MOP::Mixin::HasMethods::add_method at line 65 of Class/MOP/Mixin/HasMethods.pm, avg 653ns/call # 217 times (108µs+0s) by Class::MOP::Class::linearized_isa at line 609 of Class/MOP/Class.pm, avg 496ns/call # 172 times (120µs+0s) by Class::MOP::Attribute::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Attribute.pm:340] at line 332 of Class/MOP/Attribute.pm, avg 697ns/call # 67 times (45µs+0s) by Class::MOP::Class::is_anon_class at line 224 of Class/MOP/Class.pm, avg 676ns/call # 58 times (30µs+0s) by Class::MOP::Mixin::HasMethods::_code_is_mine at line 80 of Class/MOP/Mixin/HasMethods.pm, avg 519ns/call # 57 times (42µs+0s) by Class::MOP::Attribute::_process_accessors at line 310 of Class/MOP/Attribute.pm, avg 740ns/call # 52 times (25µs+0s) by Class::MOP::Mixin::HasMethods::wrap_method_body at line 31 of Class/MOP/Mixin/HasMethods.pm, avg 487ns/call # 36 times (20µs+0s) by Class::MOP::Class::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Class.pm:678] at line 664 of Class/MOP/Class.pm, avg 544ns/call # 33 times (28µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 35 of Class/MOP/Method/Inlined.pm, avg 855ns/call # 32 times (20µs+0s) by Class::MOP::Class::_inline_constructor at line 1055 of Class/MOP/Class.pm, avg 616ns/call # 31 times (16µs+0s) by Class::MOP::Method::Constructor::_generate_constructor_method_inline at line 109 of Class/MOP/Method/Constructor.pm, avg 529ns/call # 12 times (6µs+0s) by Class::MOP::Class::clone_object at line 404 of Class/MOP/Class.pm, avg 500ns/call # 5 times (3µs+0s) by Class::MOP::Instance::_class_name at line 71 of Class/MOP/Instance.pm, avg 640ns/call # 4 times (3µs+0s) by Class::MOP::Class::new_object at line 349 of Class/MOP/Class.pm, avg 675ns/call # 3 times (2µs+0s) by Class::MOP::Class::superclasses at line 569 of Class/MOP/Class.pm, avg 767ns/call # 2 times (800ns+0s) by Class::MOP::Module::_instantiate_module at line 59 of Class/MOP/Module.pm, avg 400ns/call # once (700ns+0s) by Class::MOP::Class::_inline_destructor at line 1089 of Class/MOP/Class.pm # once (600ns+0s) by Moose::Meta::Method::Constructor::_initialize_body at line 63 of Moose/Meta/Method/Constructor.pm sub Class::MOP::Package::name; # xsub