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