Commit | Line | Data |
---|---|---|
09bef843 SB |
1 | package attributes; |
2 | ||
2e9ae640 | 3 | our $VERSION = 0.17; |
09bef843 | 4 | |
26f2972e GS |
5 | @EXPORT_OK = qw(get reftype); |
6 | @EXPORT = (); | |
7 | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); | |
09bef843 SB |
8 | |
9 | use strict; | |
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 | ||
f1a3ce43 NC |
21 | my %deprecated; |
22 | $deprecated{CODE} = qr/\A-?(locked)\z/; | |
23 | $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} | |
24 | = qr/\A-?(unique)\z/; | |
25 | ||
c32124fe NC |
26 | sub _modify_attrs_and_deprecate { |
27 | my $svtype = shift; | |
28 | # Now that we've removed handling of locked from the XS code, we need to | |
29 | # remove it here, else it ends up in @badattrs. (If we do the deprecation in | |
30 | # XS, we can't control the warning based on *our* caller's lexical settings, | |
31 | # and the warned line is in this package) | |
32 | grep { | |
f1a3ce43 | 33 | $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { |
c32124fe | 34 | require warnings; |
f1a3ce43 | 35 | warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); |
c32124fe | 36 | 0; |
bb3abb05 FC |
37 | } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do { |
38 | require warnings; | |
39 | warnings::warnif( | |
40 | 'misc', | |
41 | "lvalue attribute " | |
42 | . (/^-/ ? "cannot be removed" : "ignored") | |
43 | . " after the subroutine has been defined" | |
44 | ); | |
45 | 0; | |
c32124fe NC |
46 | } : 1 |
47 | } _modify_attrs(@_); | |
48 | } | |
49 | ||
09bef843 | 50 | sub import { |
26f2972e GS |
51 | @_ > 2 && ref $_[2] or do { |
52 | require Exporter; | |
53 | goto &Exporter::import; | |
c0c5a66b | 54 | }; |
09bef843 SB |
55 | my (undef,$home_stash,$svref,@attrs) = @_; |
56 | ||
57 | my $svtype = uc reftype($svref); | |
58 | my $pkgmeth; | |
59 | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") | |
60 | if defined $home_stash && $home_stash ne ''; | |
61 | my @badattrs; | |
62 | if ($pkgmeth) { | |
c32124fe | 63 | my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); |
d5adc3a1 | 64 | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); |
09bef843 | 65 | if (!@badattrs && @pkgattrs) { |
20f4e289 JH |
66 | require warnings; |
67 | return unless warnings::enabled('reserved'); | |
09bef843 SB |
68 | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; |
69 | if (@pkgattrs) { | |
70 | for my $attr (@pkgattrs) { | |
71 | $attr =~ s/\(.+\z//s; | |
72 | } | |
73 | my $s = ((@pkgattrs == 1) ? '' : 's'); | |
74 | carp "$svtype package attribute$s " . | |
75 | "may clash with future reserved word$s: " . | |
0120eecf | 76 | join(' : ' , @pkgattrs); |
09bef843 SB |
77 | } |
78 | } | |
79 | } | |
80 | else { | |
c32124fe | 81 | @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); |
09bef843 SB |
82 | } |
83 | if (@badattrs) { | |
84 | croak "Invalid $svtype attribute" . | |
85 | (( @badattrs == 1 ) ? '' : 's') . | |
86 | ": " . | |
0120eecf | 87 | join(' : ', @badattrs); |
09bef843 SB |
88 | } |
89 | } | |
90 | ||
91 | sub get ($) { | |
92 | @_ == 1 && ref $_[0] or | |
93 | croak 'Usage: '.__PACKAGE__.'::get $ref'; | |
94 | my $svref = shift; | |
48462a74 NC |
95 | my $svtype = uc reftype($svref); |
96 | my $stash = _guess_stash($svref); | |
09bef843 SB |
97 | $stash = caller unless defined $stash; |
98 | my $pkgmeth; | |
99 | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") | |
100 | if defined $stash && $stash ne ''; | |
101 | return $pkgmeth ? | |
102 | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : | |
103 | (_fetch_attrs($svref)) | |
104 | ; | |
105 | } | |
106 | ||
26f2972e | 107 | sub require_version { goto &UNIVERSAL::VERSION } |
09bef843 | 108 | |
48462a74 | 109 | require XSLoader; |
da4061d3 | 110 | XSLoader::load(); |
48462a74 | 111 | |
09bef843 SB |
112 | 1; |
113 | __END__ | |
114 | #The POD goes here | |
115 | ||
116 | =head1 NAME | |
117 | ||
118 | attributes - get/set subroutine or variable attributes | |
119 | ||
120 | =head1 SYNOPSIS | |
121 | ||
122 | sub foo : method ; | |
95f0a2f1 | 123 | my ($x,@y,%z) : Bent = 1; |
09bef843 SB |
124 | my $s = sub : method { ... }; |
125 | ||
126 | use attributes (); # optional, to get subroutine declarations | |
127 | my @attrlist = attributes::get(\&foo); | |
128 | ||
26f2972e GS |
129 | use attributes 'get'; # import the attributes::get subroutine |
130 | my @attrlist = get \&foo; | |
131 | ||
09bef843 SB |
132 | =head1 DESCRIPTION |
133 | ||
134 | Subroutine declarations and definitions may optionally have attribute lists | |
135 | associated with them. (Variable C<my> declarations also may, but see the | |
136 | warning below.) Perl handles these declarations by passing some information | |
137 | about the call site and the thing being declared along with the attribute | |
26f2972e | 138 | list to this module. In particular, the first example above is equivalent to |
09bef843 SB |
139 | the following: |
140 | ||
141 | use attributes __PACKAGE__, \&foo, 'method'; | |
142 | ||
143 | The second example in the synopsis does something equivalent to this: | |
144 | ||
95f0a2f1 SB |
145 | use attributes (); |
146 | my ($x,@y,%z); | |
147 | attributes::->import(__PACKAGE__, \$x, 'Bent'); | |
148 | attributes::->import(__PACKAGE__, \@y, 'Bent'); | |
149 | attributes::->import(__PACKAGE__, \%z, 'Bent'); | |
150 | ($x,@y,%z) = 1; | |
09bef843 | 151 | |
95f0a2f1 | 152 | Yes, that's a lot of expansion. |
09bef843 | 153 | |
1d2de774 JH |
154 | B<WARNING>: attribute declarations for variables are still evolving. |
155 | The semantics and interfaces of such declarations could change in | |
156 | future versions. They are present for purposes of experimentation | |
09bef843 | 157 | with what the semantics ought to be. Do not rely on the current |
95f0a2f1 | 158 | implementation of this feature. |
09bef843 SB |
159 | |
160 | There are only a few attributes currently handled by Perl itself (or | |
161 | directly by this module, depending on how you look at it.) However, | |
162 | package-specific attributes are allowed by an extension mechanism. | |
163 | (See L<"Package-specific Attribute Handling"> below.) | |
164 | ||
95f0a2f1 SB |
165 | The setting of subroutine attributes happens at compile time. |
166 | Variable attributes in C<our> declarations are also applied at compile time. | |
167 | However, C<my> variables get their attributes applied at run-time. | |
168 | This means that you have to I<reach> the run-time component of the C<my> | |
169 | before those attributes will get applied. For example: | |
170 | ||
171 | my $x : Bent = 42 if 0; | |
172 | ||
173 | will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute | |
174 | to the variable. | |
175 | ||
1d2de774 JH |
176 | An attempt to set an unrecognized attribute is a fatal error. (The |
177 | error is trappable, but it still stops the compilation within that | |
178 | C<eval>.) Setting an attribute with a name that's all lowercase | |
179 | letters that's not a built-in attribute (such as "foo") will result in | |
180 | a warning with B<-w> or C<use warnings 'reserved'>. | |
09bef843 | 181 | |
a911a0f8 RB |
182 | =head2 What C<import> does |
183 | ||
184 | In the description it is mentioned that | |
185 | ||
186 | sub foo : method; | |
187 | ||
188 | is equivalent to | |
189 | ||
190 | use attributes __PACKAGE__, \&foo, 'method'; | |
191 | ||
192 | As you might know this calls the C<import> function of C<attributes> at compile | |
193 | time with these parameters: 'attributes', the caller's package name, the reference | |
194 | to the code and 'method'. | |
195 | ||
196 | attributes->import( __PACKAGE__, \&foo, 'method' ); | |
197 | ||
198 | So you want to know what C<import> actually does? | |
199 | ||
200 | First of all C<import> gets the type of the third parameter ('CODE' in this case). | |
201 | C<attributes.pm> checks if there is a subroutine called C<< MODIFY_<reftype>_ATTRIBUTES >> | |
202 | in the caller's namespace (here: 'main'). In this case a subroutine C<MODIFY_CODE_ATTRIBUTES> is | |
203 | required. Then this method is called to check if you have used a "bad attribute". | |
204 | The subroutine call in this example would look like | |
205 | ||
206 | MODIFY_CODE_ATTRIBUTES( 'main', \&foo, 'method' ); | |
207 | ||
208 | C<< MODIFY_<reftype>_ATTRIBUTES >> has to return a list of all "bad attributes". | |
209 | If there are any bad attributes C<import> croaks. | |
210 | ||
211 | (See L<"Package-specific Attribute Handling"> below.) | |
212 | ||
09bef843 SB |
213 | =head2 Built-in Attributes |
214 | ||
215 | The following are the built-in attributes for subroutines: | |
216 | ||
217 | =over 4 | |
218 | ||
0a8c518d | 219 | =item lvalue |
cef7f621 | 220 | |
0a8c518d NC |
221 | Indicates that the referenced subroutine is a valid lvalue and can |
222 | be assigned to. The subroutine must return a modifiable value such | |
223 | as a scalar variable, as described in L<perlsub>. | |
09bef843 SB |
224 | |
225 | =item method | |
226 | ||
0a8c518d | 227 | Indicates that the referenced subroutine is a method. A subroutine so marked |
09bef843 SB |
228 | will not trigger the "Ambiguous call resolved as CORE::%s" warning. |
229 | ||
0a8c518d | 230 | =item locked |
89752b9c | 231 | |
0a8c518d NC |
232 | The "locked" attribute has no effect in 5.10.0 and later. It was used as part |
233 | of the now-removed "Perl 5.005 threads". | |
89752b9c | 234 | |
09bef843 SB |
235 | =back |
236 | ||
09bef843 SB |
237 | =head2 Available Subroutines |
238 | ||
239 | The following subroutines are available for general use once this module | |
240 | has been loaded: | |
241 | ||
242 | =over 4 | |
243 | ||
244 | =item get | |
245 | ||
246 | This routine expects a single parameter--a reference to a | |
247 | subroutine or variable. It returns a list of attributes, which may be | |
248 | empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) | |
249 | to raise a fatal exception. If it can find an appropriate package name | |
250 | for a class method lookup, it will include the results from a | |
251 | C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in | |
26f2972e | 252 | L<"Package-specific Attribute Handling"> below. |
09bef843 SB |
253 | Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. |
254 | ||
255 | =item reftype | |
256 | ||
257 | This routine expects a single parameter--a reference to a subroutine or | |
258 | variable. It returns the built-in type of the referenced variable, | |
259 | ignoring any package into which it might have been blessed. | |
260 | This can be useful for determining the I<type> value which forms part of | |
26f2972e | 261 | the method names described in L<"Package-specific Attribute Handling"> below. |
09bef843 SB |
262 | |
263 | =back | |
264 | ||
26f2972e | 265 | Note that these routines are I<not> exported by default. |
09bef843 SB |
266 | |
267 | =head2 Package-specific Attribute Handling | |
268 | ||
269 | B<WARNING>: the mechanisms described here are still experimental. Do not | |
270 | rely on the current implementation. In particular, there is no provision | |
271 | for applying package attributes to 'cloned' copies of subroutines used as | |
272 | closures. (See L<perlref/"Making References"> for information on closures.) | |
273 | Package-specific attribute handling may change incompatibly in a future | |
274 | release. | |
275 | ||
276 | When an attribute list is present in a declaration, a check is made to see | |
277 | whether an attribute 'modify' handler is present in the appropriate package | |
278 | (or its @ISA inheritance tree). Similarly, when C<attributes::get> is | |
279 | called on a valid reference, a check is made for an appropriate attribute | |
280 | 'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package" | |
281 | determination works. | |
282 | ||
283 | The handler names are based on the underlying type of the variable being | |
284 | declared or of the reference passed. Because these attributes are | |
285 | associated with subroutine or variable declarations, this deliberately | |
286 | ignores any possibility of being blessed into some package. Thus, a | |
287 | subroutine declaration uses "CODE" as its I<type>, and even a blessed | |
288 | hash reference uses "HASH" as its I<type>. | |
289 | ||
290 | The class methods invoked for modifying and fetching are these: | |
291 | ||
292 | =over 4 | |
293 | ||
294 | =item FETCH_I<type>_ATTRIBUTES | |
295 | ||
630ad279 JH |
296 | This method is called with two arguments: the relevant package name, |
297 | and a reference to a variable or subroutine for which package-defined | |
298 | attributes are desired. The expected return value is a list of | |
299 | associated attributes. This list may be empty. | |
09bef843 SB |
300 | |
301 | =item MODIFY_I<type>_ATTRIBUTES | |
302 | ||
303 | This method is called with two fixed arguments, followed by the list of | |
304 | attributes from the relevant declaration. The two fixed arguments are | |
305 | the relevant package name and a reference to the declared subroutine or | |
fd40b977 | 306 | variable. The expected return value is a list of attributes which were |
09bef843 SB |
307 | not recognized by this handler. Note that this allows for a derived class |
308 | to delegate a call to its base class, and then only examine the attributes | |
309 | which the base class didn't already handle for it. | |
310 | ||
311 | The call to this method is currently made I<during> the processing of the | |
312 | declaration. In particular, this means that a subroutine reference will | |
313 | probably be for an undefined subroutine, even if this declaration is | |
314 | actually part of the definition. | |
315 | ||
316 | =back | |
317 | ||
318 | Calling C<attributes::get()> from within the scope of a null package | |
319 | declaration C<package ;> for an unblessed variable reference will | |
320 | not provide any starting package name for the 'fetch' method lookup. | |
321 | Thus, this circumstance will not result in a method call for package-defined | |
322 | attributes. A named subroutine knows to which symbol table entry it belongs | |
323 | (or originally belonged), and it will use the corresponding package. | |
324 | An anonymous subroutine knows the package name into which it was compiled | |
325 | (unless it was also compiled with a null package declaration), and so it | |
326 | will use that package name. | |
327 | ||
328 | =head2 Syntax of Attribute Lists | |
329 | ||
330 | An attribute list is a sequence of attribute specifications, separated by | |
0120eecf GS |
331 | whitespace or a colon (with optional whitespace). |
332 | Each attribute specification is a simple | |
09bef843 SB |
333 | name, optionally followed by a parenthesised parameter list. |
334 | If such a parameter list is present, it is scanned past as for the rules | |
335 | for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.) | |
336 | The parameter list is passed as it was found, however, and not as per C<q()>. | |
337 | ||
338 | Some examples of syntactically valid attribute lists: | |
339 | ||
0120eecf GS |
340 | switch(10,foo(7,3)) : expensive |
341 | Ugly('\(") :Bad | |
09bef843 | 342 | _5x5 |
6db6f353 | 343 | lvalue method |
09bef843 SB |
344 | |
345 | Some examples of syntactically invalid attribute lists (with annotation): | |
346 | ||
347 | switch(10,foo() # ()-string not balanced | |
348 | Ugly('(') # ()-string not balanced | |
349 | 5x5 # "5x5" not a valid identifier | |
350 | Y2::north # "Y2::north" not a simple identifier | |
0120eecf | 351 | foo + bar # "+" neither a colon nor whitespace |
09bef843 | 352 | |
26f2972e GS |
353 | =head1 EXPORTS |
354 | ||
355 | =head2 Default exports | |
356 | ||
357 | None. | |
358 | ||
359 | =head2 Available exports | |
360 | ||
361 | The routines C<get> and C<reftype> are exportable. | |
362 | ||
363 | =head2 Export tags defined | |
364 | ||
365 | The C<:ALL> tag will get all of the above exports. | |
366 | ||
09bef843 SB |
367 | =head1 EXAMPLES |
368 | ||
369 | Here are some samples of syntactically valid declarations, with annotation | |
370 | as to how they resolve internally into C<use attributes> invocations by | |
371 | perl. These examples are primarily useful to see how the "appropriate | |
372 | package" is found for the possible method lookups for package-defined | |
373 | attributes. | |
374 | ||
375 | =over 4 | |
376 | ||
377 | =item 1. | |
378 | ||
379 | Code: | |
380 | ||
381 | package Canine; | |
382 | package Dog; | |
383 | my Canine $spot : Watchful ; | |
384 | ||
385 | Effect: | |
386 | ||
95f0a2f1 SB |
387 | use attributes (); |
388 | attributes::->import(Canine => \$spot, "Watchful"); | |
09bef843 SB |
389 | |
390 | =item 2. | |
391 | ||
392 | Code: | |
393 | ||
394 | package Felis; | |
395 | my $cat : Nervous; | |
396 | ||
397 | Effect: | |
398 | ||
95f0a2f1 SB |
399 | use attributes (); |
400 | attributes::->import(Felis => \$cat, "Nervous"); | |
09bef843 SB |
401 | |
402 | =item 3. | |
403 | ||
404 | Code: | |
405 | ||
406 | package X; | |
6db6f353 | 407 | sub foo : lvalue ; |
09bef843 SB |
408 | |
409 | Effect: | |
410 | ||
6db6f353 | 411 | use attributes X => \&foo, "lvalue"; |
09bef843 SB |
412 | |
413 | =item 4. | |
414 | ||
415 | Code: | |
416 | ||
417 | package X; | |
6db6f353 | 418 | sub Y::x : lvalue { 1 } |
09bef843 SB |
419 | |
420 | Effect: | |
421 | ||
6db6f353 | 422 | use attributes Y => \&Y::x, "lvalue"; |
09bef843 SB |
423 | |
424 | =item 5. | |
425 | ||
426 | Code: | |
427 | ||
428 | package X; | |
429 | sub foo { 1 } | |
430 | ||
431 | package Y; | |
432 | BEGIN { *bar = \&X::foo; } | |
433 | ||
434 | package Z; | |
6db6f353 | 435 | sub Y::bar : lvalue ; |
09bef843 SB |
436 | |
437 | Effect: | |
438 | ||
6db6f353 | 439 | use attributes X => \&X::foo, "lvalue"; |
09bef843 SB |
440 | |
441 | =back | |
442 | ||
443 | This last example is purely for purposes of completeness. You should not | |
444 | be trying to mess with the attributes of something in a package that's | |
445 | not your own. | |
446 | ||
a911a0f8 RB |
447 | =head1 MORE EXAMPLES |
448 | ||
449 | =over 4 | |
450 | ||
451 | =item 1. | |
452 | ||
453 | sub MODIFY_CODE_ATTRIBUTES { | |
454 | my ($class,$code,@attrs) = @_; | |
455 | ||
456 | my $allowed = 'MyAttribute'; | |
457 | my @bad = grep { $_ ne $allowed } @attrs; | |
458 | ||
459 | return @bad; | |
460 | } | |
461 | ||
462 | sub foo : MyAttribute { | |
463 | print "foo\n"; | |
464 | } | |
465 | ||
466 | This example runs. At compile time C<MODIFY_CODE_ATTRIBUTES> is called. In that | |
467 | subroutine, we check if any attribute is disallowed and we return a list of | |
468 | these "bad attributes". | |
469 | ||
470 | As we return an empty list, everything is fine. | |
471 | ||
472 | =item 2. | |
473 | ||
474 | sub MODIFY_CODE_ATTRIBUTES { | |
475 | my ($class,$code,@attrs) = @_; | |
476 | ||
477 | my $allowed = 'MyAttribute'; | |
478 | my @bad = grep{ $_ ne $allowed }@attrs; | |
479 | ||
480 | return @bad; | |
481 | } | |
482 | ||
483 | sub foo : MyAttribute Test { | |
484 | print "foo\n"; | |
485 | } | |
486 | ||
487 | This example is aborted at compile time as we use the attribute "Test" which | |
488 | isn't allowed. C<MODIFY_CODE_ATTRIBUTES> returns a list that contains a single | |
489 | element ('Test'). | |
490 | ||
491 | =back | |
492 | ||
09bef843 SB |
493 | =head1 SEE ALSO |
494 | ||
495 | L<perlsub/"Private Variables via my()"> and | |
496 | L<perlsub/"Subroutine Attributes"> for details on the basic declarations; | |
09bef843 SB |
497 | L<perlfunc/use> for details on the normal invocation mechanism. |
498 | ||
499 | =cut |