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