← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:05 2010

File /usr/local/lib/perl5/5.8.8/attributes.pm
Statements Executed 32
Statement Execution Time 1.64ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111248µs324µsattributes::::importattributes::import
111123µs178µsattributes::::getattributes::get
11241µs41µsattributes::::bootstrapattributes::bootstrap (xsub)
22214µs14µsattributes::::reftypeattributes::reftype (xsub)
11213µs13µsattributes::::CORE:matchattributes::CORE:match (opcode)
1127µs7µsattributes::::_guess_stashattributes::_guess_stash (xsub)
1126µs6µsattributes::::_fetch_attrsattributes::_fetch_attrs (xsub)
1126µs6µsattributes::::_modify_attrsattributes::_modify_attrs (xsub)
1126µs6µsattributes::::_warn_reservedattributes::_warn_reserved (xsub)
0000s0sattributes::::BEGINattributes::BEGIN
0000s0sattributes::::carpattributes::carp
0000s0sattributes::::croakattributes::croak
0000s0sattributes::::require_versionattributes::require_version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package attributes;
2
315µsour $VERSION = 0.06;
4
517µs@EXPORT_OK = qw(get reftype);
615µs@EXPORT = ();
7112µs%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8
93190µs124µsuse strict;
# spent 24µs making 1 call to strict::import
10
11sub croak {
12 require Carp;
13 goto &Carp::croak;
14}
15
16sub carp {
17 require Carp;
18 goto &Carp::carp;
19}
20
21## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{}
22#sub reftype ($) ;
23#sub _fetch_attrs ($) ;
24#sub _guess_stash ($) ;
25#sub _modify_attrs ;
26#sub _warn_reserved () ;
27#
28# The extra trips through newATTRSUB in the interpreter wipe out any savings
29# from avoiding the BEGIN block. Just do the bootstrap now.
301954µs141µsBEGIN { bootstrap attributes }
# spent 41µs making 1 call to attributes::bootstrap
31
32
# spent 324µs (248+76) within attributes::import which was called # once (248µs+76µs) by base::import at line 21 of Class/DBI/Plugin/AbstractCount.pm
sub import {
3319µs @_ > 2 && ref $_[2] or do {
34 require Exporter;
35 goto &Exporter::import;
36 };
37129µs my (undef,$home_stash,$svref,@attrs) = @_;
38
39135µs18µs my $svtype = uc reftype($svref);
# spent 8µs making 1 call to attributes::reftype
4014µs my $pkgmeth;
41140µs120µs $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES")
# spent 20µs making 1 call to UNIVERSAL::can
42 if defined $home_stash && $home_stash ne '';
4315µs my @badattrs;
4419µs if ($pkgmeth) {
45127µs16µs my @pkgattrs = _modify_attrs($svref, @attrs);
# spent 6µs making 1 call to attributes::_modify_attrs
46116µs123µs @badattrs = $pkgmeth->($home_stash, $svref, @attrs);
# spent 23µs making 1 call to Class::DBI::Plugin::MODIFY_CODE_ATTRIBUTES
47110µs if (!@badattrs && @pkgattrs) {
48138µs16µs return unless _warn_reserved;
# spent 6µs making 1 call to attributes::_warn_reserved
49247µs113µs @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
# spent 13µs making 1 call to attributes::CORE:match
5015µs if (@pkgattrs) {
51 for my $attr (@pkgattrs) {
52 $attr =~ s/\(.+\z//s;
53 }
54 my $s = ((@pkgattrs == 1) ? '' : 's');
55 carp "$svtype package attribute$s " .
56 "may clash with future reserved word$s: " .
57 join(' : ' , @pkgattrs);
58 }
59 }
60 }
61 else {
62 @badattrs = _modify_attrs($svref, @attrs);
63 }
64118µs if (@badattrs) {
65 croak "Invalid $svtype attribute" .
66 (( @badattrs == 1 ) ? '' : 's') .
67 ": " .
68 join(' : ', @badattrs);
69 }
70}
71
72
# spent 178µs (123+55) within attributes::get which was called # once (123µs+55µs) by Class::DBI::Plugin::import at line 25 of Class/DBI/Plugin.pm
sub get ($) {
7316µs @_ == 1 && ref $_[0] or
74 croak 'Usage: '.__PACKAGE__.'::get $ref';
7515µs my $svref = shift;
76127µs16µs my $svtype = uc reftype $svref;
# spent 6µs making 1 call to attributes::reftype
77125µs17µs my $stash = _guess_stash $svref;
# spent 7µs making 1 call to attributes::_guess_stash
7814µs $stash = caller unless defined $stash;
7915µs my $pkgmeth;
80135µs116µs $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES")
# spent 16µs making 1 call to UNIVERSAL::can
81 if defined $stash && $stash ne '';
82154µs226µs return $pkgmeth ?
# spent 20µs making 1 call to Class::DBI::Plugin::FETCH_CODE_ATTRIBUTES # spent 6µs making 1 call to attributes::_fetch_attrs
83 (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) :
84 (_fetch_attrs($svref))
85 ;
86}
87
88sub require_version { goto &UNIVERSAL::VERSION }
89
90115µs1;
91__END__
92#The POD goes here
93
94=head1 NAME
95
96attributes - get/set subroutine or variable attributes
97
98=head1 SYNOPSIS
99
100 sub foo : method ;
101 my ($x,@y,%z) : Bent = 1;
102 my $s = sub : method { ... };
103
104 use attributes (); # optional, to get subroutine declarations
105 my @attrlist = attributes::get(\&foo);
106
107 use attributes 'get'; # import the attributes::get subroutine
108 my @attrlist = get \&foo;
109
110=head1 DESCRIPTION
111
112Subroutine declarations and definitions may optionally have attribute lists
113associated with them. (Variable C<my> declarations also may, but see the
114warning below.) Perl handles these declarations by passing some information
115about the call site and the thing being declared along with the attribute
116list to this module. In particular, the first example above is equivalent to
117the following:
118
119 use attributes __PACKAGE__, \&foo, 'method';
120
121The second example in the synopsis does something equivalent to this:
122
123 use attributes ();
124 my ($x,@y,%z);
125 attributes::->import(__PACKAGE__, \$x, 'Bent');
126 attributes::->import(__PACKAGE__, \@y, 'Bent');
127 attributes::->import(__PACKAGE__, \%z, 'Bent');
128 ($x,@y,%z) = 1;
129
130Yes, that's a lot of expansion.
131
132B<WARNING>: attribute declarations for variables are still evolving.
133The semantics and interfaces of such declarations could change in
134future versions. They are present for purposes of experimentation
135with what the semantics ought to be. Do not rely on the current
136implementation of this feature.
137
138There are only a few attributes currently handled by Perl itself (or
139directly by this module, depending on how you look at it.) However,
140package-specific attributes are allowed by an extension mechanism.
141(See L<"Package-specific Attribute Handling"> below.)
142
143The setting of subroutine attributes happens at compile time.
144Variable attributes in C<our> declarations are also applied at compile time.
145However, C<my> variables get their attributes applied at run-time.
146This means that you have to I<reach> the run-time component of the C<my>
147before those attributes will get applied. For example:
148
149 my $x : Bent = 42 if 0;
150
151will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute
152to the variable.
153
154An attempt to set an unrecognized attribute is a fatal error. (The
155error is trappable, but it still stops the compilation within that
156C<eval>.) Setting an attribute with a name that's all lowercase
157letters that's not a built-in attribute (such as "foo") will result in
158a warning with B<-w> or C<use warnings 'reserved'>.
159
160=head2 Built-in Attributes
161
162The following are the built-in attributes for subroutines:
163
164=over 4
165
166=item locked
167
168B<5.005 threads only! The use of the "locked" attribute currently
169only makes sense if you are using the deprecated "Perl 5.005 threads"
170implementation of threads.>
171
172Setting this attribute is only meaningful when the subroutine or
173method is to be called by multiple threads. When set on a method
174subroutine (i.e., one marked with the B<method> attribute below),
175Perl ensures that any invocation of it implicitly locks its first
176argument before execution. When set on a non-method subroutine,
177Perl ensures that a lock is taken on the subroutine itself before
178execution. The semantics of the lock are exactly those of one
179explicitly taken with the C<lock> operator immediately after the
180subroutine is entered.
181
182=item method
183
184Indicates that the referenced subroutine is a method.
185This has a meaning when taken together with the B<locked> attribute,
186as described there. It also means that a subroutine so marked
187will not trigger the "Ambiguous call resolved as CORE::%s" warning.
188
189=item lvalue
190
191Indicates that the referenced subroutine is a valid lvalue and can
192be assigned to. The subroutine must return a modifiable value such
193as a scalar variable, as described in L<perlsub>.
194
195=back
196
197For global variables there is C<unique> attribute: see L<perlfunc/our>.
198
199=head2 Available Subroutines
200
201The following subroutines are available for general use once this module
202has been loaded:
203
204=over 4
205
206=item get
207
208This routine expects a single parameter--a reference to a
209subroutine or variable. It returns a list of attributes, which may be
210empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
211to raise a fatal exception. If it can find an appropriate package name
212for a class method lookup, it will include the results from a
213C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
214L<"Package-specific Attribute Handling"> below.
215Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
216
217=item reftype
218
219This routine expects a single parameter--a reference to a subroutine or
220variable. It returns the built-in type of the referenced variable,
221ignoring any package into which it might have been blessed.
222This can be useful for determining the I<type> value which forms part of
223the method names described in L<"Package-specific Attribute Handling"> below.
224
225=back
226
227Note that these routines are I<not> exported by default.
228
229=head2 Package-specific Attribute Handling
230
231B<WARNING>: the mechanisms described here are still experimental. Do not
232rely on the current implementation. In particular, there is no provision
233for applying package attributes to 'cloned' copies of subroutines used as
234closures. (See L<perlref/"Making References"> for information on closures.)
235Package-specific attribute handling may change incompatibly in a future
236release.
237
238When an attribute list is present in a declaration, a check is made to see
239whether an attribute 'modify' handler is present in the appropriate package
240(or its @ISA inheritance tree). Similarly, when C<attributes::get> is
241called on a valid reference, a check is made for an appropriate attribute
242'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package"
243determination works.
244
245The handler names are based on the underlying type of the variable being
246declared or of the reference passed. Because these attributes are
247associated with subroutine or variable declarations, this deliberately
248ignores any possibility of being blessed into some package. Thus, a
249subroutine declaration uses "CODE" as its I<type>, and even a blessed
250hash reference uses "HASH" as its I<type>.
251
252The class methods invoked for modifying and fetching are these:
253
254=over 4
255
256=item FETCH_I<type>_ATTRIBUTES
257
258This method receives a single argument, which is a reference to the
259variable or subroutine for which package-defined attributes are desired.
260The expected return value is a list of associated attributes.
261This list may be empty.
262
263=item MODIFY_I<type>_ATTRIBUTES
264
265This method is called with two fixed arguments, followed by the list of
266attributes from the relevant declaration. The two fixed arguments are
267the relevant package name and a reference to the declared subroutine or
268variable. The expected return value is a list of attributes which were
269not recognized by this handler. Note that this allows for a derived class
270to delegate a call to its base class, and then only examine the attributes
271which the base class didn't already handle for it.
272
273The call to this method is currently made I<during> the processing of the
274declaration. In particular, this means that a subroutine reference will
275probably be for an undefined subroutine, even if this declaration is
276actually part of the definition.
277
278=back
279
280Calling C<attributes::get()> from within the scope of a null package
281declaration C<package ;> for an unblessed variable reference will
282not provide any starting package name for the 'fetch' method lookup.
283Thus, this circumstance will not result in a method call for package-defined
284attributes. A named subroutine knows to which symbol table entry it belongs
285(or originally belonged), and it will use the corresponding package.
286An anonymous subroutine knows the package name into which it was compiled
287(unless it was also compiled with a null package declaration), and so it
288will use that package name.
289
290=head2 Syntax of Attribute Lists
291
292An attribute list is a sequence of attribute specifications, separated by
293whitespace or a colon (with optional whitespace).
294Each attribute specification is a simple
295name, optionally followed by a parenthesised parameter list.
296If such a parameter list is present, it is scanned past as for the rules
297for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.)
298The parameter list is passed as it was found, however, and not as per C<q()>.
299
300Some examples of syntactically valid attribute lists:
301
302 switch(10,foo(7,3)) : expensive
303 Ugly('\(") :Bad
304 _5x5
305 locked method
306
307Some examples of syntactically invalid attribute lists (with annotation):
308
309 switch(10,foo() # ()-string not balanced
310 Ugly('(') # ()-string not balanced
311 5x5 # "5x5" not a valid identifier
312 Y2::north # "Y2::north" not a simple identifier
313 foo + bar # "+" neither a colon nor whitespace
314
315=head1 EXPORTS
316
317=head2 Default exports
318
319None.
320
321=head2 Available exports
322
323The routines C<get> and C<reftype> are exportable.
324
325=head2 Export tags defined
326
327The C<:ALL> tag will get all of the above exports.
328
329=head1 EXAMPLES
330
331Here are some samples of syntactically valid declarations, with annotation
332as to how they resolve internally into C<use attributes> invocations by
333perl. These examples are primarily useful to see how the "appropriate
334package" is found for the possible method lookups for package-defined
335attributes.
336
337=over 4
338
339=item 1.
340
341Code:
342
343 package Canine;
344 package Dog;
345 my Canine $spot : Watchful ;
346
347Effect:
348
349 use attributes ();
350 attributes::->import(Canine => \$spot, "Watchful");
351
352=item 2.
353
354Code:
355
356 package Felis;
357 my $cat : Nervous;
358
359Effect:
360
361 use attributes ();
362 attributes::->import(Felis => \$cat, "Nervous");
363
364=item 3.
365
366Code:
367
368 package X;
369 sub foo : locked ;
370
371Effect:
372
373 use attributes X => \&foo, "locked";
374
375=item 4.
376
377Code:
378
379 package X;
380 sub Y::x : locked { 1 }
381
382Effect:
383
384 use attributes Y => \&Y::x, "locked";
385
386=item 5.
387
388Code:
389
390 package X;
391 sub foo { 1 }
392
393 package Y;
394 BEGIN { *bar = \&X::foo; }
395
396 package Z;
397 sub Y::bar : locked ;
398
399Effect:
400
401 use attributes X => \&X::foo, "locked";
402
403=back
404
405This last example is purely for purposes of completeness. You should not
406be trying to mess with the attributes of something in a package that's
407not your own.
408
409=head1 SEE ALSO
410
411L<perlsub/"Private Variables via my()"> and
412L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
413L<attrs> for the obsolescent form of subroutine attribute specification
414which this module replaces;
415L<perlfunc/use> for details on the normal invocation mechanism.
416
417=cut
418
# spent 13µs within attributes::CORE:match which was called # once (13µs+0s) by attributes::import at line 49 of attributes.pm
sub attributes::CORE:match; # xsub
# spent 6µs within attributes::_fetch_attrs which was called # once (6µs+0s) by attributes::get at line 82 of attributes.pm
sub attributes::_fetch_attrs; # xsub
# spent 7µs within attributes::_guess_stash which was called # once (7µs+0s) by attributes::get at line 77 of attributes.pm
sub attributes::_guess_stash; # xsub
# spent 6µs within attributes::_modify_attrs which was called # once (6µs+0s) by attributes::import at line 45 of attributes.pm
sub attributes::_modify_attrs; # xsub
# spent 6µs within attributes::_warn_reserved which was called # once (6µs+0s) by attributes::import at line 48 of attributes.pm
sub attributes::_warn_reserved; # xsub
# spent 41µs within attributes::bootstrap which was called # once (41µs+0s) by base::import at line 30 of attributes.pm
sub attributes::bootstrap; # xsub
# spent 14µs within attributes::reftype which was called 2 times, avg 7µs/call: # once (8µs+0s) by attributes::import at line 39 of attributes.pm # once (6µs+0s) by attributes::get at line 76 of attributes.pm
sub attributes::reftype; # xsub