This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document :shared and :unique in attributes.pm
[perl5.git] / ext / attributes / attributes.pm
1 package attributes;
2
3 our $VERSION = 0.21;
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 my %deprecated;
22 $deprecated{CODE} = qr/\A-?(locked)\z/;
23 $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR}
24     = qr/\A-?(unique)\z/;
25
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 {
33         $deprecated{$svtype} && /$deprecated{$svtype}/ ? do {
34             require warnings;
35             warnings::warnif('deprecated', "Attribute \"$1\" is deprecated");
36             0;
37         } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do {
38             require warnings;
39             warnings::warnif(
40                 'misc',
41                 "lvalue attribute "
42                    . (/^-/ ? "removed from" : "applied to")
43                    . " already-defined subroutine"
44             );
45             0;
46         } : 1
47     } _modify_attrs(@_);
48 }
49
50 sub import {
51     @_ > 2 && ref $_[2] or do {
52         require Exporter;
53         goto &Exporter::import;
54     };
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) {
63         my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs);
64         @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
65         if (!@badattrs && @pkgattrs) {
66             require warnings;
67             return unless warnings::enabled('reserved');
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: " .
76                     join(' : ' , @pkgattrs);
77             }
78         }
79     }
80     else {
81         @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs);
82     }
83     if (@badattrs) {
84         croak "Invalid $svtype attribute" .
85             (( @badattrs == 1 ) ? '' : 's') .
86             ": " .
87             join(' : ', @badattrs);
88     }
89 }
90
91 sub get ($) {
92     @_ == 1  && ref $_[0] or
93         croak 'Usage: '.__PACKAGE__.'::get $ref';
94     my $svref = shift;
95     my $svtype = uc reftype($svref);
96     my $stash = _guess_stash($svref);
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
107 sub require_version { goto &UNIVERSAL::VERSION }
108
109 require XSLoader;
110 XSLoader::load();
111
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 ;
123   my ($x,@y,%z) : Bent = 1;
124   my $s = sub : method { ... };
125
126   use attributes ();    # optional, to get subroutine declarations
127   my @attrlist = attributes::get(\&foo);
128
129   use attributes 'get'; # import the attributes::get subroutine
130   my @attrlist = get \&foo;
131
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
138 list to this module.  In particular, the first example above is equivalent to
139 the following:
140
141     use attributes __PACKAGE__, \&foo, 'method';
142
143 The second example in the synopsis does something equivalent to this:
144
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;
151
152 Yes, that's a lot of expansion.
153
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
157 with what the semantics ought to be.  Do not rely on the current
158 implementation of this feature.
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
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
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'>.
181
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
203 subroutine C<MODIFY_CODE_ATTRIBUTES> is required.  Then this
204 method is called to check if you have used a "bad attribute".
205 The subroutine call in this example would look like
206
207   MODIFY_CODE_ATTRIBUTES( 'main', \&foo, 'method' );
208
209 C<< MODIFY_<reftype>_ATTRIBUTES >> has to return a list of all "bad attributes".
210 If there are any bad attributes C<import> croaks.
211
212 (See L<"Package-specific Attribute Handling"> below.)
213
214 =head2 Built-in Attributes
215
216 The following are the built-in attributes for subroutines:
217
218 =over 4
219
220 =item lvalue
221
222 Indicates that the referenced subroutine is a valid lvalue and can
223 be assigned to.  The subroutine must return a modifiable value such
224 as a scalar variable, as described in L<perlsub>.
225
226 This module allows one to set this attribute on a subroutine that is
227 already defined.  For Perl subroutines (XSUBs are fine), it may or may not
228 do what you want, depending on the code inside the subroutine, with details
229 subject to change in future Perl versions.  You may run into problems with
230 lvalue context not being propagated properly into the subroutine, or maybe
231 even assertion failures.  For this reason, a warning is emitted if warnings
232 are enabled.  In other words, you should only do this if you really know
233 what you are doing.  You have been warned.
234
235 =item method
236
237 Indicates that the referenced subroutine
238 is a method.  A subroutine so marked
239 will not trigger the "Ambiguous call resolved as CORE::%s" warning.
240
241 =item locked
242
243 The "locked" attribute is deprecated, and has no effect in 5.10.0 and later.
244 It was used as part of the now-removed "Perl 5.005 threads".
245
246 =back
247
248 The following are the built-in attributes for variables:
249
250 =over 4
251
252 =item shared
253
254 Indicates that the referenced variable can be shared across different threads
255 when used in conjunction with the L<threads> and L<threads::shared> modules.
256
257 =item unique
258
259 The "unique" attribute is deprecated, and has no effect in 5.10.0 and later.
260 It used to indicate that a single copy of an C<our> variable was to be used by
261 all interpreters should the program happen to be running in a
262 multi-interpreter environment.
263
264 =back
265
266 =head2 Available Subroutines
267
268 The following subroutines are available for general use once this module
269 has been loaded:
270
271 =over 4
272
273 =item get
274
275 This routine expects a single parameter--a reference to a
276 subroutine or variable.  It returns a list of attributes, which may be
277 empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
278 to raise a fatal exception.  If it can find an appropriate package name
279 for a class method lookup, it will include the results from a
280 C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
281 L<"Package-specific Attribute Handling"> below.
282 Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
283
284 =item reftype
285
286 This routine expects a single parameter--a reference to a subroutine or
287 variable.  It returns the built-in type of the referenced variable,
288 ignoring any package into which it might have been blessed.
289 This can be useful for determining the I<type> value which forms part of
290 the method names described in L<"Package-specific Attribute Handling"> below.
291
292 =back
293
294 Note that these routines are I<not> exported by default.
295
296 =head2 Package-specific Attribute Handling
297
298 B<WARNING>: the mechanisms described here are still experimental.  Do not
299 rely on the current implementation.  In particular, there is no provision
300 for applying package attributes to 'cloned' copies of subroutines used as
301 closures.  (See L<perlref/"Making References"> for information on closures.)
302 Package-specific attribute handling may change incompatibly in a future
303 release.
304
305 When an attribute list is present in a declaration, a check is made to see
306 whether an attribute 'modify' handler is present in the appropriate package
307 (or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
308 called on a valid reference, a check is made for an appropriate attribute
309 'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
310 determination works.
311
312 The handler names are based on the underlying type of the variable being
313 declared or of the reference passed.  Because these attributes are
314 associated with subroutine or variable declarations, this deliberately
315 ignores any possibility of being blessed into some package.  Thus, a
316 subroutine declaration uses "CODE" as its I<type>, and even a blessed
317 hash reference uses "HASH" as its I<type>.
318
319 The class methods invoked for modifying and fetching are these:
320
321 =over 4
322
323 =item FETCH_I<type>_ATTRIBUTES
324
325 This method is called with two arguments:  the relevant package name,
326 and a reference to a variable or subroutine for which package-defined
327 attributes are desired.  The expected return value is a list of
328 associated attributes.  This list may be empty.
329
330 =item MODIFY_I<type>_ATTRIBUTES
331
332 This method is called with two fixed arguments, followed by the list of
333 attributes from the relevant declaration.  The two fixed arguments are
334 the relevant package name and a reference to the declared subroutine or
335 variable.  The expected return value is a list of attributes which were
336 not recognized by this handler.  Note that this allows for a derived class
337 to delegate a call to its base class, and then only examine the attributes
338 which the base class didn't already handle for it.
339
340 The call to this method is currently made I<during> the processing of the
341 declaration.  In particular, this means that a subroutine reference will
342 probably be for an undefined subroutine, even if this declaration is
343 actually part of the definition.
344
345 =back
346
347 Calling C<attributes::get()> from within the scope of a null package
348 declaration C<package ;> for an unblessed variable reference will
349 not provide any starting package name for the 'fetch' method lookup.
350 Thus, this circumstance will not result in a method call for package-defined
351 attributes.  A named subroutine knows to which symbol table entry it belongs
352 (or originally belonged), and it will use the corresponding package.
353 An anonymous subroutine knows the package name into which it was compiled
354 (unless it was also compiled with a null package declaration), and so it
355 will use that package name.
356
357 =head2 Syntax of Attribute Lists
358
359 An attribute list is a sequence of attribute specifications, separated by
360 whitespace or a colon (with optional whitespace).
361 Each attribute specification is a simple
362 name, optionally followed by a parenthesised parameter list.
363 If such a parameter list is present, it is scanned past as for the rules
364 for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
365 The parameter list is passed as it was found, however, and not as per C<q()>.
366
367 Some examples of syntactically valid attribute lists:
368
369     switch(10,foo(7,3))  :  expensive
370     Ugly('\(") :Bad
371     _5x5
372     lvalue method
373
374 Some examples of syntactically invalid attribute lists (with annotation):
375
376     switch(10,foo()             # ()-string not balanced
377     Ugly('(')                   # ()-string not balanced
378     5x5                         # "5x5" not a valid identifier
379     Y2::north                   # "Y2::north" not a simple identifier
380     foo + bar                   # "+" neither a colon nor whitespace
381
382 =head1 EXPORTS
383
384 =head2 Default exports
385
386 None.
387
388 =head2 Available exports
389
390 The routines C<get> and C<reftype> are exportable.
391
392 =head2 Export tags defined
393
394 The C<:ALL> tag will get all of the above exports.
395
396 =head1 EXAMPLES
397
398 Here are some samples of syntactically valid declarations, with annotation
399 as to how they resolve internally into C<use attributes> invocations by
400 perl.  These examples are primarily useful to see how the "appropriate
401 package" is found for the possible method lookups for package-defined
402 attributes.
403
404 =over 4
405
406 =item 1.
407
408 Code:
409
410     package Canine;
411     package Dog;
412     my Canine $spot : Watchful ;
413
414 Effect:
415
416     use attributes ();
417     attributes::->import(Canine => \$spot, "Watchful");
418
419 =item 2.
420
421 Code:
422
423     package Felis;
424     my $cat : Nervous;
425
426 Effect:
427
428     use attributes ();
429     attributes::->import(Felis => \$cat, "Nervous");
430
431 =item 3.
432
433 Code:
434
435     package X;
436     sub foo : lvalue ;
437
438 Effect:
439
440     use attributes X => \&foo, "lvalue";
441
442 =item 4.
443
444 Code:
445
446     package X;
447     sub Y::x : lvalue { 1 }
448
449 Effect:
450
451     use attributes Y => \&Y::x, "lvalue";
452
453 =item 5.
454
455 Code:
456
457     package X;
458     sub foo { 1 }
459
460     package Y;
461     BEGIN { *bar = \&X::foo; }
462
463     package Z;
464     sub Y::bar : lvalue ;
465
466 Effect:
467
468     use attributes X => \&X::foo, "lvalue";
469
470 =back
471
472 This last example is purely for purposes of completeness.  You should not
473 be trying to mess with the attributes of something in a package that's
474 not your own.
475
476 =head1 MORE EXAMPLES
477
478 =over 4
479
480 =item 1.
481
482     sub MODIFY_CODE_ATTRIBUTES {
483        my ($class,$code,@attrs) = @_;
484
485        my $allowed = 'MyAttribute';
486        my @bad = grep { $_ ne $allowed } @attrs;
487
488        return @bad;
489     }
490
491     sub foo : MyAttribute {
492        print "foo\n";
493     }
494
495 This example runs.  At compile time
496 C<MODIFY_CODE_ATTRIBUTES> is called.  In that
497 subroutine, we check if any attribute is disallowed and we return a list of
498 these "bad attributes".
499
500 As we return an empty list, everything is fine.
501
502 =item 2.
503
504   sub MODIFY_CODE_ATTRIBUTES {
505      my ($class,$code,@attrs) = @_;
506
507      my $allowed = 'MyAttribute';
508      my @bad = grep{ $_ ne $allowed }@attrs;
509
510      return @bad;
511   }
512
513   sub foo : MyAttribute Test {
514      print "foo\n";
515   }
516
517 This example is aborted at compile time as we use the attribute "Test" which
518 isn't allowed.  C<MODIFY_CODE_ATTRIBUTES>
519 returns a list that contains a single
520 element ('Test').
521
522 =back
523
524 =head1 SEE ALSO
525
526 L<perlsub/"Private Variables via my()"> and
527 L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
528 L<perlfunc/use> for details on the normal invocation mechanism.
529
530 =cut