Profile of /usr/local/lib/perl5/5.8.8/attributes.pm

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
1	1	1	248µs	324µs	attributes::::importattributes::import
1	1	1	123µs	178µs	attributes::::getattributes::get
1	1	2	41µs	41µs	attributes::::bootstrapattributes::bootstrap (xsub)
2	2	2	14µs	14µs	attributes::::reftypeattributes::reftype (xsub)
1	1	2	13µs	13µs	attributes::::CORE:matchattributes::CORE:match (opcode)
1	1	2	7µs	7µs	attributes::::_guess_stashattributes::_guess_stash (xsub)
1	1	2	6µs	6µs	attributes::::_fetch_attrsattributes::_fetch_attrs (xsub)
1	1	2	6µs	6µs	attributes::::_modify_attrsattributes::_modify_attrs (xsub)
1	1	2	6µs	6µs	attributes::::_warn_reservedattributes::_warn_reserved (xsub)
0	0	0	0s	0s	attributes::::BEGINattributes::BEGIN
0	0	0	0s	0s	attributes::::carpattributes::carp
0	0	0	0s	0s	attributes::::croakattributes::croak
0	0	0	0s	0s	attributes::::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
1					package attributes;
2
3	1	5µs			our $VERSION = 0.06;
4
5	1	7µs			@EXPORT_OK = qw(get reftype);
6	1	5µs			@EXPORT = ();
7	1	12µs			%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8
9	3	190µs	1	24µs	use strict; # spent 24µs making 1 call to strict::import
10
11					sub croak {
12					require Carp;
13					goto &Carp::croak;
14					}
15
16					sub 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.
30	1	954µs	1	41µs	BEGIN { 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 {
33	15	292µs			@_ > 2 && ref $_[2] or do {
34					require Exporter;
35					goto &Exporter::import;
36					};
37					my (undef,$home_stash,$svref,@attrs) = @_;
38
39					my $svtype = uc reftype($svref); # spent 8µs making 1 call to attributes::reftype
40					my $pkgmeth;
41					$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 '';
43					my @badattrs;
44					if ($pkgmeth) {
45					my @pkgattrs = _modify_attrs($svref, @attrs); # spent 6µs making 1 call to attributes::_modify_attrs
46					@badattrs = $pkgmeth->($home_stash, $svref, @attrs); # spent 23µs making 1 call to Class::DBI::Plugin::MODIFY_CODE_ATTRIBUTES
47					if (!@badattrs && @pkgattrs) {
48					return unless _warn_reserved; # spent 6µs making 1 call to attributes::_warn_reserved
49					@pkgattrs = grep { m/\A[[:lower:]]+(?:\z\|\()/ } @pkgattrs; # spent 13µs making 1 call to attributes::CORE:match
50					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					}
64					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 ($) {
73	8	161µs			@_ == 1 && ref $_[0] or
74					croak 'Usage: '.__PACKAGE__.'::get $ref';
75					my $svref = shift;
76					my $svtype = uc reftype $svref; # spent 6µs making 1 call to attributes::reftype
77					my $stash = _guess_stash $svref; # spent 7µs making 1 call to attributes::_guess_stash
78					$stash = caller unless defined $stash;
79					my $pkgmeth;
80					$pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") # spent 16µs making 1 call to UNIVERSAL::can
81					if defined $stash && $stash ne '';
82					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
88					sub require_version { goto &UNIVERSAL::VERSION }
89
90	1	15µs			1;
91					__END__
92					#The POD goes here
93
94					=head1 NAME
95
96					attributes - 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
112					Subroutine declarations and definitions may optionally have attribute lists
113					associated with them. (Variable C<my> declarations also may, but see the
114					warning below.) Perl handles these declarations by passing some information
115					about the call site and the thing being declared along with the attribute
116					list to this module. In particular, the first example above is equivalent to
117					the following:
118
119					use attributes __PACKAGE__, \&foo, 'method';
120
121					The 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
130					Yes, that's a lot of expansion.
131
132					B<WARNING>: attribute declarations for variables are still evolving.
133					The semantics and interfaces of such declarations could change in
134					future versions. They are present for purposes of experimentation
135					with what the semantics ought to be. Do not rely on the current
136					implementation of this feature.
137
138					There are only a few attributes currently handled by Perl itself (or
139					directly by this module, depending on how you look at it.) However,
140					package-specific attributes are allowed by an extension mechanism.
141					(See L<"Package-specific Attribute Handling"> below.)
142
143					The setting of subroutine attributes happens at compile time.
144					Variable attributes in C<our> declarations are also applied at compile time.
145					However, C<my> variables get their attributes applied at run-time.
146					This means that you have to I<reach> the run-time component of the C<my>
147					before those attributes will get applied. For example:
148
149					my $x : Bent = 42 if 0;
150
151					will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute
152					to the variable.
153
154					An attempt to set an unrecognized attribute is a fatal error. (The
155					error is trappable, but it still stops the compilation within that
156					C<eval>.) Setting an attribute with a name that's all lowercase
157					letters that's not a built-in attribute (such as "foo") will result in
158					a warning with B<-w> or C<use warnings 'reserved'>.
159
160					=head2 Built-in Attributes
161
162					The following are the built-in attributes for subroutines:
163
164					=over 4
165
166					=item locked
167
168					B<5.005 threads only! The use of the "locked" attribute currently
169					only makes sense if you are using the deprecated "Perl 5.005 threads"
170					implementation of threads.>
171
172					Setting this attribute is only meaningful when the subroutine or
173					method is to be called by multiple threads. When set on a method
174					subroutine (i.e., one marked with the B<method> attribute below),
175					Perl ensures that any invocation of it implicitly locks its first
176					argument before execution. When set on a non-method subroutine,
177					Perl ensures that a lock is taken on the subroutine itself before
178					execution. The semantics of the lock are exactly those of one
179					explicitly taken with the C<lock> operator immediately after the
180					subroutine is entered.
181
182					=item method
183
184					Indicates that the referenced subroutine is a method.
185					This has a meaning when taken together with the B<locked> attribute,
186					as described there. It also means that a subroutine so marked
187					will not trigger the "Ambiguous call resolved as CORE::%s" warning.
188
189					=item lvalue
190
191					Indicates that the referenced subroutine is a valid lvalue and can
192					be assigned to. The subroutine must return a modifiable value such
193					as a scalar variable, as described in L<perlsub>.
194
195					=back
196
197					For global variables there is C<unique> attribute: see L<perlfunc/our>.
198
199					=head2 Available Subroutines
200
201					The following subroutines are available for general use once this module
202					has been loaded:
203
204					=over 4
205
206					=item get
207
208					This routine expects a single parameter--a reference to a
209					subroutine or variable. It returns a list of attributes, which may be
210					empty. If passed invalid arguments, it uses die() (via L<Carp::croak\|Carp>)
211					to raise a fatal exception. If it can find an appropriate package name
212					for a class method lookup, it will include the results from a
213					C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
214					L<"Package-specific Attribute Handling"> below.
215					Otherwise, only L<built-in attributes\|"Built-in Attributes"> will be returned.
216
217					=item reftype
218
219					This routine expects a single parameter--a reference to a subroutine or
220					variable. It returns the built-in type of the referenced variable,
221					ignoring any package into which it might have been blessed.
222					This can be useful for determining the I<type> value which forms part of
223					the method names described in L<"Package-specific Attribute Handling"> below.
224
225					=back
226
227					Note that these routines are I<not> exported by default.
228
229					=head2 Package-specific Attribute Handling
230
231					B<WARNING>: the mechanisms described here are still experimental. Do not
232					rely on the current implementation. In particular, there is no provision
233					for applying package attributes to 'cloned' copies of subroutines used as
234					closures. (See L<perlref/"Making References"> for information on closures.)
235					Package-specific attribute handling may change incompatibly in a future
236					release.
237
238					When an attribute list is present in a declaration, a check is made to see
239					whether an attribute 'modify' handler is present in the appropriate package
240					(or its @ISA inheritance tree). Similarly, when C<attributes::get> is
241					called on a valid reference, a check is made for an appropriate attribute
242					'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package"
243					determination works.
244
245					The handler names are based on the underlying type of the variable being
246					declared or of the reference passed. Because these attributes are
247					associated with subroutine or variable declarations, this deliberately
248					ignores any possibility of being blessed into some package. Thus, a
249					subroutine declaration uses "CODE" as its I<type>, and even a blessed
250					hash reference uses "HASH" as its I<type>.
251
252					The class methods invoked for modifying and fetching are these:
253
254					=over 4
255
256					=item FETCH_I<type>_ATTRIBUTES
257
258					This method receives a single argument, which is a reference to the
259					variable or subroutine for which package-defined attributes are desired.
260					The expected return value is a list of associated attributes.
261					This list may be empty.
262
263					=item MODIFY_I<type>_ATTRIBUTES
264
265					This method is called with two fixed arguments, followed by the list of
266					attributes from the relevant declaration. The two fixed arguments are
267					the relevant package name and a reference to the declared subroutine or
268					variable. The expected return value is a list of attributes which were
269					not recognized by this handler. Note that this allows for a derived class
270					to delegate a call to its base class, and then only examine the attributes
271					which the base class didn't already handle for it.
272
273					The call to this method is currently made I<during> the processing of the
274					declaration. In particular, this means that a subroutine reference will
275					probably be for an undefined subroutine, even if this declaration is
276					actually part of the definition.
277
278					=back
279
280					Calling C<attributes::get()> from within the scope of a null package
281					declaration C<package ;> for an unblessed variable reference will
282					not provide any starting package name for the 'fetch' method lookup.
283					Thus, this circumstance will not result in a method call for package-defined
284					attributes. A named subroutine knows to which symbol table entry it belongs
285					(or originally belonged), and it will use the corresponding package.
286					An 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
288					will use that package name.
289
290					=head2 Syntax of Attribute Lists
291
292					An attribute list is a sequence of attribute specifications, separated by
293					whitespace or a colon (with optional whitespace).
294					Each attribute specification is a simple
295					name, optionally followed by a parenthesised parameter list.
296					If such a parameter list is present, it is scanned past as for the rules
297					for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.)
298					The parameter list is passed as it was found, however, and not as per C<q()>.
299
300					Some examples of syntactically valid attribute lists:
301
302					switch(10,foo(7,3)) : expensive
303					Ugly('\(") :Bad
304					_5x5
305					locked method
306
307					Some 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
319					None.
320
321					=head2 Available exports
322
323					The routines C<get> and C<reftype> are exportable.
324
325					=head2 Export tags defined
326
327					The C<:ALL> tag will get all of the above exports.
328
329					=head1 EXAMPLES
330
331					Here are some samples of syntactically valid declarations, with annotation
332					as to how they resolve internally into C<use attributes> invocations by
333					perl. These examples are primarily useful to see how the "appropriate
334					package" is found for the possible method lookups for package-defined
335					attributes.
336
337					=over 4
338
339					=item 1.
340
341					Code:
342
343					package Canine;
344					package Dog;
345					my Canine $spot : Watchful ;
346
347					Effect:
348
349					use attributes ();
350					attributes::->import(Canine => \$spot, "Watchful");
351
352					=item 2.
353
354					Code:
355
356					package Felis;
357					my $cat : Nervous;
358
359					Effect:
360
361					use attributes ();
362					attributes::->import(Felis => \$cat, "Nervous");
363
364					=item 3.
365
366					Code:
367
368					package X;
369					sub foo : locked ;
370
371					Effect:
372
373					use attributes X => \&foo, "locked";
374
375					=item 4.
376
377					Code:
378
379					package X;
380					sub Y::x : locked { 1 }
381
382					Effect:
383
384					use attributes Y => \&Y::x, "locked";
385
386					=item 5.
387
388					Code:
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
399					Effect:
400
401					use attributes X => \&X::foo, "locked";
402
403					=back
404
405					This last example is purely for purposes of completeness. You should not
406					be trying to mess with the attributes of something in a package that's
407					not your own.
408
409					=head1 SEE ALSO
410
411					L<perlsub/"Private Variables via my()"> and
412					L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
413					L<attrs> for the obsolescent form of subroutine attribute specification
414					which this module replaces;
415					L<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