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