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