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