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