extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / attributes.pm
1 package attributes;
2
3 our $VERSION = 0.06;
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 B<5.005 threads only!  The use of the "locked" attribute currently
169 only makes sense if you are using the deprecated "Perl 5.005 threads"
170 implementation of threads.>
171
172 Setting this attribute is only meaningful when the subroutine or
173 method is to be called by multiple threads.  When set on a method
174 subroutine (i.e., one marked with the B<method> attribute below),
175 Perl ensures that any invocation of it implicitly locks its first
176 argument before execution.  When set on a non-method subroutine,
177 Perl ensures that a lock is taken on the subroutine itself before
178 execution.  The semantics of the lock are exactly those of one
179 explicitly taken with the C<lock> operator immediately after the
180 subroutine is entered.
181
182 =item method
183
184 Indicates that the referenced subroutine is a method.
185 This has a meaning when taken together with the B<locked> attribute,
186 as described there.  It also means that a subroutine so marked
187 will not trigger the "Ambiguous call resolved as CORE::%s" warning.
188
189 =item lvalue
190
191 Indicates that the referenced subroutine is a valid lvalue and can
192 be assigned to. The subroutine must return a modifiable value such
193 as a scalar variable, as described in L<perlsub>.
194
195 =back
196
197 For global variables there is C<unique> attribute: see L<perlfunc/our>.
198
199 =head2 Available Subroutines
200
201 The following subroutines are available for general use once this module
202 has been loaded:
203
204 =over 4
205
206 =item get
207
208 This routine expects a single parameter--a reference to a
209 subroutine or variable.  It returns a list of attributes, which may be
210 empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
211 to raise a fatal exception.  If it can find an appropriate package name
212 for a class method lookup, it will include the results from a
213 C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
214 L<"Package-specific Attribute Handling"> below.
215 Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
216
217 =item reftype
218
219 This routine expects a single parameter--a reference to a subroutine or
220 variable.  It returns the built-in type of the referenced variable,
221 ignoring any package into which it might have been blessed.
222 This can be useful for determining the I<type> value which forms part of
223 the method names described in L<"Package-specific Attribute Handling"> below.
224
225 =back
226
227 Note that these routines are I<not> exported by default.
228
229 =head2 Package-specific Attribute Handling
230
231 B<WARNING>: the mechanisms described here are still experimental.  Do not
232 rely on the current implementation.  In particular, there is no provision
233 for applying package attributes to 'cloned' copies of subroutines used as
234 closures.  (See L<perlref/"Making References"> for information on closures.)
235 Package-specific attribute handling may change incompatibly in a future
236 release.
237
238 When an attribute list is present in a declaration, a check is made to see
239 whether an attribute 'modify' handler is present in the appropriate package
240 (or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
241 called on a valid reference, a check is made for an appropriate attribute
242 'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
243 determination works.
244
245 The handler names are based on the underlying type of the variable being
246 declared or of the reference passed.  Because these attributes are
247 associated with subroutine or variable declarations, this deliberately
248 ignores any possibility of being blessed into some package.  Thus, a
249 subroutine declaration uses "CODE" as its I<type>, and even a blessed
250 hash reference uses "HASH" as its I<type>.
251
252 The class methods invoked for modifying and fetching are these:
253
254 =over 4
255
256 =item FETCH_I<type>_ATTRIBUTES
257
258 This method receives a single argument, which is a reference to the
259 variable or subroutine for which package-defined attributes are desired.
260 The expected return value is a list of associated attributes.
261 This list may be empty.
262
263 =item MODIFY_I<type>_ATTRIBUTES
264
265 This method is called with two fixed arguments, followed by the list of
266 attributes from the relevant declaration.  The two fixed arguments are
267 the relevant package name and a reference to the declared subroutine or
268 variable.  The expected return value is a list of attributes which were
269 not recognized by this handler.  Note that this allows for a derived class
270 to delegate a call to its base class, and then only examine the attributes
271 which the base class didn't already handle for it.
272
273 The call to this method is currently made I<during> the processing of the
274 declaration.  In particular, this means that a subroutine reference will
275 probably be for an undefined subroutine, even if this declaration is
276 actually part of the definition.
277
278 =back
279
280 Calling C<attributes::get()> from within the scope of a null package
281 declaration C<package ;> for an unblessed variable reference will
282 not provide any starting package name for the 'fetch' method lookup.
283 Thus, this circumstance will not result in a method call for package-defined
284 attributes.  A named subroutine knows to which symbol table entry it belongs
285 (or originally belonged), and it will use the corresponding package.
286 An anonymous subroutine knows the package name into which it was compiled
287 (unless it was also compiled with a null package declaration), and so it
288 will use that package name.
289
290 =head2 Syntax of Attribute Lists
291
292 An attribute list is a sequence of attribute specifications, separated by
293 whitespace or a colon (with optional whitespace).
294 Each attribute specification is a simple
295 name, optionally followed by a parenthesised parameter list.
296 If such a parameter list is present, it is scanned past as for the rules
297 for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
298 The parameter list is passed as it was found, however, and not as per C<q()>.
299
300 Some examples of syntactically valid attribute lists:
301
302     switch(10,foo(7,3))  :  expensive
303     Ugly('\(") :Bad
304     _5x5
305     locked method
306
307 Some examples of syntactically invalid attribute lists (with annotation):
308
309     switch(10,foo()             # ()-string not balanced
310     Ugly('(')                   # ()-string not balanced
311     5x5                         # "5x5" not a valid identifier
312     Y2::north                   # "Y2::north" not a simple identifier
313     foo + bar                   # "+" neither a colon nor whitespace
314
315 =head1 EXPORTS
316
317 =head2 Default exports
318
319 None.
320
321 =head2 Available exports
322
323 The routines C<get> and C<reftype> are exportable.
324
325 =head2 Export tags defined
326
327 The C<:ALL> tag will get all of the above exports.
328
329 =head1 EXAMPLES
330
331 Here are some samples of syntactically valid declarations, with annotation
332 as to how they resolve internally into C<use attributes> invocations by
333 perl.  These examples are primarily useful to see how the "appropriate
334 package" is found for the possible method lookups for package-defined
335 attributes.
336
337 =over 4
338
339 =item 1.
340
341 Code:
342
343     package Canine;
344     package Dog;
345     my Canine $spot : Watchful ;
346
347 Effect:
348
349     use attributes ();
350     attributes::->import(Canine => \$spot, "Watchful");
351
352 =item 2.
353
354 Code:
355
356     package Felis;
357     my $cat : Nervous;
358
359 Effect:
360
361     use attributes ();
362     attributes::->import(Felis => \$cat, "Nervous");
363
364 =item 3.
365
366 Code:
367
368     package X;
369     sub foo : locked ;
370
371 Effect:
372
373     use attributes X => \&foo, "locked";
374
375 =item 4.
376
377 Code:
378
379     package X;
380     sub Y::x : locked { 1 }
381
382 Effect:
383
384     use attributes Y => \&Y::x, "locked";
385
386 =item 5.
387
388 Code:
389
390     package X;
391     sub foo { 1 }
392
393     package Y;
394     BEGIN { *bar = \&X::foo; }
395
396     package Z;
397     sub Y::bar : locked ;
398
399 Effect:
400
401     use attributes X => \&X::foo, "locked";
402
403 =back
404
405 This last example is purely for purposes of completeness.  You should not
406 be trying to mess with the attributes of something in a package that's
407 not your own.
408
409 =head1 SEE ALSO
410
411 L<perlsub/"Private Variables via my()"> and
412 L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
413 L<attrs> for the obsolescent form of subroutine attribute specification
414 which this module replaces;
415 L<perlfunc/use> for details on the normal invocation mechanism.
416
417 =cut
418