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