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