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