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

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:34 2010

File | /usr/local/lib/perl5/5.10.1/attributes.pm
Statements Executed | 18
Statement Execution Time | 454µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 22µs | 28µs | attributes::::importattributes::import
1 | 1 | 1 | 19µs | 22µs | attributes::::BEGIN@9attributes::BEGIN@9
1 | 1 | 1 | 9µs | 15µs | attributes::::BEGIN@29attributes::BEGIN@29
1 | 1 | 2 | 6µs | 6µs | attributes::::bootstrapattributes::bootstrap (xsub)
1 | 1 | 2 | 1µs | 1µs | attributes::::_modify_attrsattributes::_modify_attrs (xsub)
1 | 1 | 2 | 800ns | 800ns | attributes::::reftypeattributes::reftype (xsub)
0 | 0 | 0 | 0s | 0s | attributes::::carpattributes::carp
0 | 0 | 0 | 0s | 0s | attributes::::croakattributes::croak
0 | 0 | 0 | 0s | 0s | attributes::::getattributes::get
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 | 300ns |  |  | our $VERSION = 0.09;
4 |  |  |  |  |
5 | 1 | 1µs |  |  | @EXPORT_OK = qw(get reftype);
6 | 1 | 100ns |  |  | @EXPORT = ();
7 | 1 | 2µs |  |  | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8 |  |  |  |  |
9 | 3 | 67µs | 2 | 25µs | # spent 22µs (19+3) within attributes::BEGIN@9 which was called # once (19µs+3µs) by DynaLoader::BEGIN@97 at line 9 use strict; # spent 22µs making 1 call to attributes::BEGIN@9 # spent 3µ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 |  |  |  |  | #
27 |  |  |  |  | # The extra trips through newATTRSUB in the interpreter wipe out any savings
28 |  |  |  |  | # from avoiding the BEGIN block. Just do the bootstrap now.
29 | 1 | 347µs | 2 | 22µs | # spent 15µs (9+6) within attributes::BEGIN@29 which was called # once (9µs+6µs) by DynaLoader::BEGIN@97 at line 29 BEGIN { bootstrap attributes } # spent 15µs making 1 call to attributes::BEGIN@29 # spent 6µs making 1 call to attributes::bootstrap
30 |  |  |  |  |
31 |  |  |  |  | # spent 28µs (22+6) within attributes::import which was called # once (22µs+6µs) by DynaLoader::BEGIN@97 at line 97 of XSLoader.pm sub import {
32 | 8 | 24µs |  |  | @_ > 2 && ref $_[2] or do {
33 |  |  |  |  | require Exporter;
34 |  |  |  |  | goto &Exporter::import;
35 |  |  |  |  | };
36 |  |  |  |  | my (undef,$home_stash,$svref,@attrs) = @_;
37 |  |  |  |  |
38 |  |  |  |  | my $svtype = uc reftype($svref); # spent 800ns making 1 call to attributes::reftype
39 |  |  |  |  | my $pkgmeth;
40 |  |  |  |  | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 4µs making 1 call to UNIVERSAL::can
41 |  |  |  |  | if defined $home_stash && $home_stash ne '';
42 |  |  |  |  | my @badattrs;
43 | 1 | 5µs |  |  | if ($pkgmeth) {
44 |  |  |  |  | my @pkgattrs = _modify_attrs($svref, @attrs);
45 |  |  |  |  | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
46 |  |  |  |  | if (!@badattrs && @pkgattrs) {
47 |  |  |  |  | require warnings;
48 |  |  |  |  | return unless warnings::enabled('reserved');
49 |  |  |  |  | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
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); # spent 1µs making 1 call to attributes::_modify_attrs
63 |  |  |  |  | }
64 |  |  |  |  | if (@badattrs) {
65 |  |  |  |  | croak "Invalid $svtype attribute" .
66 |  |  |  |  | (( @badattrs == 1 ) ? '' : 's') .
67 |  |  |  |  | ": " .
68 |  |  |  |  | join(' : ', @badattrs);
69 |  |  |  |  | }
70 |  |  |  |  | }
71 |  |  |  |  |
72 |  |  |  |  | sub get ($) {
73 |  |  |  |  | @_ == 1 && ref $_[0] or
74 |  |  |  |  | croak 'Usage: '.__PACKAGE__.'::get $ref';
75 |  |  |  |  | my $svref = shift;
76 |  |  |  |  | my $svtype = uc reftype $svref;
77 |  |  |  |  | my $stash = _guess_stash $svref;
78 |  |  |  |  | $stash = caller unless defined $stash;
79 |  |  |  |  | my $pkgmeth;
80 |  |  |  |  | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES")
81 |  |  |  |  | if defined $stash && $stash ne '';
82 |  |  |  |  | return $pkgmeth ?
83 |  |  |  |  | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) :
84 |  |  |  |  | (_fetch_attrs($svref))
85 |  |  |  |  | ;
86 |  |  |  |  | }
87 |  |  |  |  |
88 |  |  |  |  | sub require_version { goto &UNIVERSAL::VERSION }
89 |  |  |  |  |
90 | 1 | 7µ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 What C<import> does
161 |  |  |  |  |
162 |  |  |  |  | In the description it is mentioned that
163 |  |  |  |  |
164 |  |  |  |  | sub foo : method;
165 |  |  |  |  |
166 |  |  |  |  | is equivalent to
167 |  |  |  |  |
168 |  |  |  |  | use attributes __PACKAGE__, \&foo, 'method';
169 |  |  |  |  |
170 |  |  |  |  | As you might know this calls the C<import> function of C<attributes> at compile
171 |  |  |  |  | time with these parameters: 'attributes', the caller's package name, the reference
172 |  |  |  |  | to the code and 'method'.
173 |  |  |  |  |
174 |  |  |  |  | attributes->import( __PACKAGE__, \&foo, 'method' );
175 |  |  |  |  |
176 |  |  |  |  | So you want to know what C<import> actually does?
177 |  |  |  |  |
178 |  |  |  |  | First of all C<import> gets the type of the third parameter ('CODE' in this case).
179 |  |  |  |  | C<attributes.pm> checks if there is a subroutine called C<< MODIFY_<reftype>_ATTRIBUTES >>
180 |  |  |  |  | in the caller's namespace (here: 'main'). In this case a subroutine C<MODIFY_CODE_ATTRIBUTES> is
181 |  |  |  |  | required. Then this method is called to check if you have used a "bad attribute".
182 |  |  |  |  | The subroutine call in this example would look like
183 |  |  |  |  |
184 |  |  |  |  | MODIFY_CODE_ATTRIBUTES( 'main', \&foo, 'method' );
185 |  |  |  |  |
186 |  |  |  |  | C<< MODIFY_<reftype>_ATTRIBUTES >> has to return a list of all "bad attributes".
187 |  |  |  |  | If there are any bad attributes C<import> croaks.
188 |  |  |  |  |
189 |  |  |  |  | (See L<"Package-specific Attribute Handling"> below.)
190 |  |  |  |  |
191 |  |  |  |  | =head2 Built-in Attributes
192 |  |  |  |  |
193 |  |  |  |  | The following are the built-in attributes for subroutines:
194 |  |  |  |  |
195 |  |  |  |  | =over 4
196 |  |  |  |  |
197 |  |  |  |  | =item locked
198 |  |  |  |  |
199 |  |  |  |  | B<5.005 threads only! The use of the "locked" attribute currently
200 |  |  |  |  | only makes sense if you are using the deprecated "Perl 5.005 threads"
201 |  |  |  |  | implementation of threads.>
202 |  |  |  |  |
203 |  |  |  |  | Setting this attribute is only meaningful when the subroutine or
204 |  |  |  |  | method is to be called by multiple threads. When set on a method
205 |  |  |  |  | subroutine (i.e., one marked with the B<method> attribute below),
206 |  |  |  |  | Perl ensures that any invocation of it implicitly locks its first
207 |  |  |  |  | argument before execution. When set on a non-method subroutine,
208 |  |  |  |  | Perl ensures that a lock is taken on the subroutine itself before
209 |  |  |  |  | execution. The semantics of the lock are exactly those of one
210 |  |  |  |  | explicitly taken with the C<lock> operator immediately after the
211 |  |  |  |  | subroutine is entered.
212 |  |  |  |  |
213 |  |  |  |  | =item method
214 |  |  |  |  |
215 |  |  |  |  | Indicates that the referenced subroutine is a method.
216 |  |  |  |  | This has a meaning when taken together with the B<locked> attribute,
217 |  |  |  |  | as described there. It also means that a subroutine so marked
218 |  |  |  |  | will not trigger the "Ambiguous call resolved as CORE::%s" warning.
219 |  |  |  |  |
220 |  |  |  |  | =item lvalue
221 |  |  |  |  |
222 |  |  |  |  | Indicates that the referenced subroutine is a valid lvalue and can
223 |  |  |  |  | be assigned to. The subroutine must return a modifiable value such
224 |  |  |  |  | as a scalar variable, as described in L<perlsub>.
225 |  |  |  |  |
226 |  |  |  |  | =back
227 |  |  |  |  |
228 |  |  |  |  | For global variables there is C<unique> attribute: see L<perlfunc/our>.
229 |  |  |  |  |
230 |  |  |  |  | =head2 Available Subroutines
231 |  |  |  |  |
232 |  |  |  |  | The following subroutines are available for general use once this module
233 |  |  |  |  | has been loaded:
234 |  |  |  |  |
235 |  |  |  |  | =over 4
236 |  |  |  |  |
237 |  |  |  |  | =item get
238 |  |  |  |  |
239 |  |  |  |  | This routine expects a single parameter--a reference to a
240 |  |  |  |  | subroutine or variable. It returns a list of attributes, which may be
241 |  |  |  |  | empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
242 |  |  |  |  | to raise a fatal exception. If it can find an appropriate package name
243 |  |  |  |  | for a class method lookup, it will include the results from a
244 |  |  |  |  | C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
245 |  |  |  |  | L<"Package-specific Attribute Handling"> below.
246 |  |  |  |  | Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
247 |  |  |  |  |
248 |  |  |  |  | =item reftype
249 |  |  |  |  |
250 |  |  |  |  | This routine expects a single parameter--a reference to a subroutine or
251 |  |  |  |  | variable. It returns the built-in type of the referenced variable,
252 |  |  |  |  | ignoring any package into which it might have been blessed.
253 |  |  |  |  | This can be useful for determining the I<type> value which forms part of
254 |  |  |  |  | the method names described in L<"Package-specific Attribute Handling"> below.
255 |  |  |  |  |
256 |  |  |  |  | =back
257 |  |  |  |  |
258 |  |  |  |  | Note that these routines are I<not> exported by default.
259 |  |  |  |  |
260 |  |  |  |  | =head2 Package-specific Attribute Handling
261 |  |  |  |  |
262 |  |  |  |  | B<WARNING>: the mechanisms described here are still experimental. Do not
263 |  |  |  |  | rely on the current implementation. In particular, there is no provision
264 |  |  |  |  | for applying package attributes to 'cloned' copies of subroutines used as
265 |  |  |  |  | closures. (See L<perlref/"Making References"> for information on closures.)
266 |  |  |  |  | Package-specific attribute handling may change incompatibly in a future
267 |  |  |  |  | release.
268 |  |  |  |  |
269 |  |  |  |  | When an attribute list is present in a declaration, a check is made to see
270 |  |  |  |  | whether an attribute 'modify' handler is present in the appropriate package
271 |  |  |  |  | (or its @ISA inheritance tree). Similarly, when C<attributes::get> is
272 |  |  |  |  | called on a valid reference, a check is made for an appropriate attribute
273 |  |  |  |  | 'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package"
274 |  |  |  |  | determination works.
275 |  |  |  |  |
276 |  |  |  |  | The handler names are based on the underlying type of the variable being
277 |  |  |  |  | declared or of the reference passed. Because these attributes are
278 |  |  |  |  | associated with subroutine or variable declarations, this deliberately
279 |  |  |  |  | ignores any possibility of being blessed into some package. Thus, a
280 |  |  |  |  | subroutine declaration uses "CODE" as its I<type>, and even a blessed
281 |  |  |  |  | hash reference uses "HASH" as its I<type>.
282 |  |  |  |  |
283 |  |  |  |  | The class methods invoked for modifying and fetching are these:
284 |  |  |  |  |
285 |  |  |  |  | =over 4
286 |  |  |  |  |
287 |  |  |  |  | =item FETCH_I<type>_ATTRIBUTES
288 |  |  |  |  |
289 |  |  |  |  | This method is called with two arguments: the relevant package name,
290 |  |  |  |  | and a reference to a variable or subroutine for which package-defined
291 |  |  |  |  | attributes are desired. The expected return value is a list of
292 |  |  |  |  | associated attributes. This list may be empty.
293 |  |  |  |  |
294 |  |  |  |  | =item MODIFY_I<type>_ATTRIBUTES
295 |  |  |  |  |
296 |  |  |  |  | This method is called with two fixed arguments, followed by the list of
297 |  |  |  |  | attributes from the relevant declaration. The two fixed arguments are
298 |  |  |  |  | the relevant package name and a reference to the declared subroutine or
299 |  |  |  |  | variable. The expected return value is a list of attributes which were
300 |  |  |  |  | not recognized by this handler. Note that this allows for a derived class
301 |  |  |  |  | to delegate a call to its base class, and then only examine the attributes
302 |  |  |  |  | which the base class didn't already handle for it.
303 |  |  |  |  |
304 |  |  |  |  | The call to this method is currently made I<during> the processing of the
305 |  |  |  |  | declaration. In particular, this means that a subroutine reference will
306 |  |  |  |  | probably be for an undefined subroutine, even if this declaration is
307 |  |  |  |  | actually part of the definition.
308 |  |  |  |  |
309 |  |  |  |  | =back
310 |  |  |  |  |
311 |  |  |  |  | Calling C<attributes::get()> from within the scope of a null package
312 |  |  |  |  | declaration C<package ;> for an unblessed variable reference will
313 |  |  |  |  | not provide any starting package name for the 'fetch' method lookup.
314 |  |  |  |  | Thus, this circumstance will not result in a method call for package-defined
315 |  |  |  |  | attributes. A named subroutine knows to which symbol table entry it belongs
316 |  |  |  |  | (or originally belonged), and it will use the corresponding package.
317 |  |  |  |  | An anonymous subroutine knows the package name into which it was compiled
318 |  |  |  |  | (unless it was also compiled with a null package declaration), and so it
319 |  |  |  |  | will use that package name.
320 |  |  |  |  |
321 |  |  |  |  | =head2 Syntax of Attribute Lists
322 |  |  |  |  |
323 |  |  |  |  | An attribute list is a sequence of attribute specifications, separated by
324 |  |  |  |  | whitespace or a colon (with optional whitespace).
325 |  |  |  |  | Each attribute specification is a simple
326 |  |  |  |  | name, optionally followed by a parenthesised parameter list.
327 |  |  |  |  | If such a parameter list is present, it is scanned past as for the rules
328 |  |  |  |  | for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.)
329 |  |  |  |  | The parameter list is passed as it was found, however, and not as per C<q()>.
330 |  |  |  |  |
331 |  |  |  |  | Some examples of syntactically valid attribute lists:
332 |  |  |  |  |
333 |  |  |  |  | switch(10,foo(7,3)) : expensive
334 |  |  |  |  | Ugly('\(") :Bad
335 |  |  |  |  | _5x5
336 |  |  |  |  | locked method
337 |  |  |  |  |
338 |  |  |  |  | Some examples of syntactically invalid attribute lists (with annotation):
339 |  |  |  |  |
340 |  |  |  |  | switch(10,foo() # ()-string not balanced
341 |  |  |  |  | Ugly('(') # ()-string not balanced
342 |  |  |  |  | 5x5 # "5x5" not a valid identifier
343 |  |  |  |  | Y2::north # "Y2::north" not a simple identifier
344 |  |  |  |  | foo + bar # "+" neither a colon nor whitespace
345 |  |  |  |  |
346 |  |  |  |  | =head1 EXPORTS
347 |  |  |  |  |
348 |  |  |  |  | =head2 Default exports
349 |  |  |  |  |
350 |  |  |  |  | None.
351 |  |  |  |  |
352 |  |  |  |  | =head2 Available exports
353 |  |  |  |  |
354 |  |  |  |  | The routines C<get> and C<reftype> are exportable.
355 |  |  |  |  |
356 |  |  |  |  | =head2 Export tags defined
357 |  |  |  |  |
358 |  |  |  |  | The C<:ALL> tag will get all of the above exports.
359 |  |  |  |  |
360 |  |  |  |  | =head1 EXAMPLES
361 |  |  |  |  |
362 |  |  |  |  | Here are some samples of syntactically valid declarations, with annotation
363 |  |  |  |  | as to how they resolve internally into C<use attributes> invocations by
364 |  |  |  |  | perl. These examples are primarily useful to see how the "appropriate
365 |  |  |  |  | package" is found for the possible method lookups for package-defined
366 |  |  |  |  | attributes.
367 |  |  |  |  |
368 |  |  |  |  | =over 4
369 |  |  |  |  |
370 |  |  |  |  | =item 1.
371 |  |  |  |  |
372 |  |  |  |  | Code:
373 |  |  |  |  |
374 |  |  |  |  | package Canine;
375 |  |  |  |  | package Dog;
376 |  |  |  |  | my Canine $spot : Watchful ;
377 |  |  |  |  |
378 |  |  |  |  | Effect:
379 |  |  |  |  |
380 |  |  |  |  | use attributes ();
381 |  |  |  |  | attributes::->import(Canine => \$spot, "Watchful");
382 |  |  |  |  |
383 |  |  |  |  | =item 2.
384 |  |  |  |  |
385 |  |  |  |  | Code:
386 |  |  |  |  |
387 |  |  |  |  | package Felis;
388 |  |  |  |  | my $cat : Nervous;
389 |  |  |  |  |
390 |  |  |  |  | Effect:
391 |  |  |  |  |
392 |  |  |  |  | use attributes ();
393 |  |  |  |  | attributes::->import(Felis => \$cat, "Nervous");
394 |  |  |  |  |
395 |  |  |  |  | =item 3.
396 |  |  |  |  |
397 |  |  |  |  | Code:
398 |  |  |  |  |
399 |  |  |  |  | package X;
400 |  |  |  |  | sub foo : locked ;
401 |  |  |  |  |
402 |  |  |  |  | Effect:
403 |  |  |  |  |
404 |  |  |  |  | use attributes X => \&foo, "locked";
405 |  |  |  |  |
406 |  |  |  |  | =item 4.
407 |  |  |  |  |
408 |  |  |  |  | Code:
409 |  |  |  |  |
410 |  |  |  |  | package X;
411 |  |  |  |  | sub Y::x : locked { 1 }
412 |  |  |  |  |
413 |  |  |  |  | Effect:
414 |  |  |  |  |
415 |  |  |  |  | use attributes Y => \&Y::x, "locked";
416 |  |  |  |  |
417 |  |  |  |  | =item 5.
418 |  |  |  |  |
419 |  |  |  |  | Code:
420 |  |  |  |  |
421 |  |  |  |  | package X;
422 |  |  |  |  | sub foo { 1 }
423 |  |  |  |  |
424 |  |  |  |  | package Y;
425 |  |  |  |  | BEGIN { *bar = \&X::foo; }
426 |  |  |  |  |
427 |  |  |  |  | package Z;
428 |  |  |  |  | sub Y::bar : locked ;
429 |  |  |  |  |
430 |  |  |  |  | Effect:
431 |  |  |  |  |
432 |  |  |  |  | use attributes X => \&X::foo, "locked";
433 |  |  |  |  |
434 |  |  |  |  | =back
435 |  |  |  |  |
436 |  |  |  |  | This last example is purely for purposes of completeness. You should not
437 |  |  |  |  | be trying to mess with the attributes of something in a package that's
438 |  |  |  |  | not your own.
439 |  |  |  |  |
440 |  |  |  |  | =head1 MORE EXAMPLES
441 |  |  |  |  |
442 |  |  |  |  | =over 4
443 |  |  |  |  |
444 |  |  |  |  | =item 1.
445 |  |  |  |  |
446 |  |  |  |  | sub MODIFY_CODE_ATTRIBUTES {
447 |  |  |  |  | my ($class,$code,@attrs) = @_;
448 |  |  |  |  |
449 |  |  |  |  | my $allowed = 'MyAttribute';
450 |  |  |  |  | my @bad = grep { $_ ne $allowed } @attrs;
451 |  |  |  |  |
452 |  |  |  |  | return @bad;
453 |  |  |  |  | }
454 |  |  |  |  |
455 |  |  |  |  | sub foo : MyAttribute {
456 |  |  |  |  | print "foo\n";
457 |  |  |  |  | }
458 |  |  |  |  |
459 |  |  |  |  | This example runs. At compile time C<MODIFY_CODE_ATTRIBUTES> is called. In that
460 |  |  |  |  | subroutine, we check if any attribute is disallowed and we return a list of
461 |  |  |  |  | these "bad attributes".
462 |  |  |  |  |
463 |  |  |  |  | As we return an empty list, everything is fine.
464 |  |  |  |  |
465 |  |  |  |  | =item 2.
466 |  |  |  |  |
467 |  |  |  |  | sub MODIFY_CODE_ATTRIBUTES {
468 |  |  |  |  | my ($class,$code,@attrs) = @_;
469 |  |  |  |  |
470 |  |  |  |  | my $allowed = 'MyAttribute';
471 |  |  |  |  | my @bad = grep{ $_ ne $allowed }@attrs;
472 |  |  |  |  |
473 |  |  |  |  | return @bad;
474 |  |  |  |  | }
475 |  |  |  |  |
476 |  |  |  |  | sub foo : MyAttribute Test {
477 |  |  |  |  | print "foo\n";
478 |  |  |  |  | }
479 |  |  |  |  |
480 |  |  |  |  | This example is aborted at compile time as we use the attribute "Test" which
481 |  |  |  |  | isn't allowed. C<MODIFY_CODE_ATTRIBUTES> returns a list that contains a single
482 |  |  |  |  | element ('Test').
483 |  |  |  |  |
484 |  |  |  |  | =back
485 |  |  |  |  |
486 |  |  |  |  | =head1 SEE ALSO
487 |  |  |  |  |
488 |  |  |  |  | L<perlsub/"Private Variables via my()"> and
489 |  |  |  |  | L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
490 |  |  |  |  | L<attrs> for the obsolescent form of subroutine attribute specification
491 |  |  |  |  | which this module replaces;
492 |  |  |  |  | L<perlfunc/use> for details on the normal invocation mechanism.
493 |  |  |  |  |
494 |  |  |  |  | =cut
495 |  |  |  |  |
|  |  |  |  | # spent 1µs within attributes::_modify_attrs which was called # once (1µs+0s) by attributes::import at line 62 of attributes.pm sub attributes::_modify_attrs; # xsub
|  |  |  |  | # spent 6µs within attributes::bootstrap which was called # once (6µs+0s) by attributes::BEGIN@29 at line 29 of attributes.pm sub attributes::bootstrap; # xsub
|  |  |  |  | # spent 800ns within attributes::reftype which was called # once (800ns+0s) by attributes::import at line 38 of attributes.pm sub attributes::reftype; # xsub