Commit | Line | Data |
dc6b6eef |
1 | package Attribute::Handlers; |
2 | use 5.006; |
3 | use Carp; |
4 | use warnings; |
9df0c874 |
5 | $VERSION = '0.70'; |
dc6b6eef |
6 | $DB::single=1; |
7 | |
9df0c874 |
8 | my %symcache; |
dc6b6eef |
9 | sub findsym { |
10 | my ($pkg, $ref, $type) = @_; |
9df0c874 |
11 | return $symcache{$pkg,$ref} if $symcache{$pkg,$ref}; |
dc6b6eef |
12 | $type ||= ref($ref); |
9df0c874 |
13 | my $found; |
dc6b6eef |
14 | foreach my $sym ( values %{$pkg."::"} ) { |
9df0c874 |
15 | return $symcache{$pkg,$ref} = \$sym |
16 | if *{$sym}{$type} && *{$sym}{$type} == $ref; |
dc6b6eef |
17 | } |
18 | } |
19 | |
20 | my %validtype = ( |
21 | VAR => [qw[SCALAR ARRAY HASH]], |
22 | ANY => [qw[SCALAR ARRAY HASH CODE]], |
23 | "" => [qw[SCALAR ARRAY HASH CODE]], |
24 | SCALAR => [qw[SCALAR]], |
25 | ARRAY => [qw[ARRAY]], |
26 | HASH => [qw[HASH]], |
27 | CODE => [qw[CODE]], |
28 | ); |
29 | my %lastattr; |
30 | my @declarations; |
31 | my %raw; |
9df0c874 |
32 | my %phase; |
dc6b6eef |
33 | my %sigil = (SCALAR=>'$', ARRAY=>'@', HASH=>'%'); |
34 | |
9df0c874 |
35 | sub _usage_AH_ { |
36 | croak "Usage: use $_[0] autotie => {AttrName => TieClassName,...}"; |
37 | } |
dc6b6eef |
38 | |
39 | sub import { |
40 | my $class = shift @_; |
9df0c874 |
41 | return unless $class eq "Attribute::Handlers"; |
dc6b6eef |
42 | while (@_) { |
43 | my $cmd = shift; |
44 | if ($cmd eq 'autotie') { |
45 | my $mapping = shift; |
9df0c874 |
46 | _usage_AH_ $class unless ref($mapping) eq 'HASH'; |
dc6b6eef |
47 | while (my($attr, $tieclass) = each %$mapping) { |
9df0c874 |
48 | $tieclass =~ s/^([_a-z]\w*(::[_a-z]\w*))(.*)/$1/is; |
49 | my $args = $3||'()'; |
50 | usage $class unless $attr =~ m/^[_a-z]\w*(::[_a-z]\w*)*$/i |
51 | && $tieclass =~ m/^[_a-z]\w*(::[_a-z]\w*)/i |
dc6b6eef |
52 | && eval "use base $tieclass; 1"; |
9df0c874 |
53 | if ($tieclass->isa('Exporter')) { |
54 | local $Exporter::ExportLevel = 2; |
55 | $tieclass->import(eval $args); |
56 | } |
57 | $attr =~ s/__CALLER__/caller(1)/e; |
58 | $attr = caller()."::".$attr unless $attr =~ /::/; |
dc6b6eef |
59 | eval qq{ |
60 | sub $attr : ATTR(VAR) { |
61 | my (\$ref, \$data) = \@_[2,4]; |
62 | \$data = [ \$data ] unless ref \$data eq 'ARRAY'; |
9df0c874 |
63 | # print \$ref, ": "; |
64 | # use Data::Dumper 'Dumper'; |
65 | # print Dumper [ [\$ref, \$data] ]; |
66 | my \$type = ref(\$ref)||"value (".(\$ref||"<undef>").")"; |
dc6b6eef |
67 | (\$type eq 'SCALAR')? tie \$\$ref,'$tieclass',\@\$data |
68 | :(\$type eq 'ARRAY') ? tie \@\$ref,'$tieclass',\@\$data |
69 | :(\$type eq 'HASH') ? tie \%\$ref,'$tieclass',\@\$data |
9df0c874 |
70 | : die "Can't autotie a \$type\n" |
dc6b6eef |
71 | } 1 |
72 | } or die "Internal error: $@"; |
73 | } |
74 | } |
75 | else { |
76 | croak "Can't understand $_"; |
77 | } |
78 | } |
79 | } |
9df0c874 |
80 | sub _resolve_lastattr { |
dc6b6eef |
81 | return unless $lastattr{ref}; |
82 | my $sym = findsym @lastattr{'pkg','ref'} |
83 | or die "Internal error: $lastattr{pkg} symbol went missing"; |
84 | my $name = *{$sym}{NAME}; |
85 | warn "Declaration of $name attribute in package $lastattr{pkg} may clash with future reserved word\n" |
86 | if $^W and $name !~ /[A-Z]/; |
87 | foreach ( @{$validtype{$lastattr{type}}} ) { |
88 | *{"$lastattr{pkg}::_ATTR_${_}_${name}"} = $lastattr{ref}; |
89 | } |
90 | %lastattr = (); |
91 | } |
92 | |
93 | sub AUTOLOAD { |
94 | my ($class) = @_; |
95 | $AUTOLOAD =~ /_ATTR_(.*?)_(.*)/ or |
96 | croak "Can't locate class method '$AUTOLOAD' via package '$class'"; |
97 | croak "Attribute handler '$2' doesn't handle $1 attributes"; |
98 | } |
99 | |
100 | sub DESTROY {} |
101 | |
102 | my $builtin = qr/lvalue|method|locked/; |
103 | |
9df0c874 |
104 | sub _gen_handler_AH_() { |
dc6b6eef |
105 | return sub { |
9df0c874 |
106 | _resolve_lastattr; |
dc6b6eef |
107 | my ($pkg, $ref, @attrs) = @_; |
108 | foreach (@attrs) { |
109 | my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/i or next; |
110 | if ($attr eq 'ATTR') { |
111 | $data ||= "ANY"; |
112 | $raw{$ref} = $data =~ s/\s*,?\s*RAWDATA\s*,?\s*//; |
9df0c874 |
113 | $phase{$ref}{BEGIN} = 1 |
114 | if $data =~ s/\s*,?\s*(BEGIN)\s*,?\s*//; |
115 | $phase{$ref}{INIT} = 1 |
116 | if $data =~ s/\s*,?\s*(INIT)\s*,?\s*//; |
117 | $phase{$ref}{END} = 1 |
118 | if $data =~ s/\s*,?\s*(END)\s*,?\s*//; |
119 | $phase{$ref}{CHECK} = 1 |
120 | if $data =~ s/\s*,?\s*(CHECK)\s*,?\s*// |
121 | || ! keys %{$phase{$ref}}; |
122 | croak "Can't have two ATTR specifiers on one subroutine" |
123 | if keys %lastattr; |
dc6b6eef |
124 | croak "Bad attribute type: ATTR($data)" |
125 | unless $validtype{$data}; |
126 | %lastattr=(pkg=>$pkg,ref=>$ref,type=>$data); |
127 | } |
128 | else { |
129 | my $handler = $pkg->can($attr); |
130 | next unless $handler; |
9df0c874 |
131 | my $decl = [$pkg, $ref, $attr, $data, |
132 | $raw{$handler}, $phase{$handler}]; |
133 | _apply_handler_AH_($decl,'BEGIN'); |
134 | push @declarations, $decl; |
dc6b6eef |
135 | } |
136 | $_ = undef; |
137 | } |
138 | return grep {defined && !/$builtin/} @attrs; |
139 | } |
140 | } |
141 | |
9df0c874 |
142 | *{"MODIFY_${_}_ATTRIBUTES"} = _gen_handler_AH_ foreach @{$validtype{ANY}}; |
dc6b6eef |
143 | push @UNIVERSAL::ISA, 'Attribute::Handlers' |
144 | unless grep /^Attribute::Handlers$/, @UNIVERSAL::ISA; |
145 | |
9df0c874 |
146 | sub _apply_handler_AH_ { |
147 | my ($declaration, $phase) = @_; |
148 | my ($pkg, $ref, $attr, $data, $raw, $handlerphase) = @$declaration; |
149 | return unless $handlerphase->{$phase}; |
150 | # print STDERR "Handling $attr on $ref in $phase with [$data]\n"; |
151 | my $type = ref $ref; |
152 | my $handler = "_ATTR_${type}_${attr}"; |
153 | my $sym = findsym($pkg, $ref); |
154 | $sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL'; |
155 | no warnings; |
156 | my $evaled = !$raw && eval("package $pkg; no warnings; |
157 | local \$SIG{__WARN__}=sub{die}; [$data]"); |
158 | $data = ($evaled && $data =~ /^\s*\[/) ? [$evaled] |
159 | : ($evaled) ? $evaled |
160 | : [$data]; |
161 | $pkg->$handler($sym, |
162 | (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref), |
163 | $attr, |
164 | (@$data>1? $data : $data->[0]), |
165 | $phase, |
166 | ); |
167 | return 1; |
168 | } |
169 | |
dc6b6eef |
170 | CHECK { |
9df0c874 |
171 | _resolve_lastattr; |
172 | _apply_handler_AH_($_,'CHECK') foreach @declarations; |
dc6b6eef |
173 | } |
174 | |
9df0c874 |
175 | INIT { _apply_handler_AH_($_,'INIT') foreach @declarations } |
176 | |
177 | END { _apply_handler_AH_($_,'END') foreach @declarations } |
178 | |
dc6b6eef |
179 | 1; |
180 | __END__ |
181 | |
182 | =head1 NAME |
183 | |
184 | Attribute::Handlers - Simpler definition of attribute handlers |
185 | |
186 | =head1 VERSION |
187 | |
9df0c874 |
188 | This document describes version 0.70 of Attribute::Handlers, |
189 | released June 3, 2001. |
dc6b6eef |
190 | |
191 | =head1 SYNOPSIS |
192 | |
193 | package MyClass; |
194 | require v5.6.0; |
195 | use Attribute::Handlers; |
196 | no warnings 'redefine'; |
197 | |
198 | |
199 | sub Good : ATTR(SCALAR) { |
200 | my ($package, $symbol, $referent, $attr, $data) = @_; |
201 | |
202 | # Invoked for any scalar variable with a :Good attribute, |
203 | # provided the variable was declared in MyClass (or |
204 | # a derived class) or typed to MyClass. |
205 | |
206 | # Do whatever to $referent here (executed in CHECK phase). |
207 | ... |
208 | } |
209 | |
210 | sub Bad : ATTR(SCALAR) { |
211 | # Invoked for any scalar variable with a :Bad attribute, |
212 | # provided the variable was declared in MyClass (or |
213 | # a derived class) or typed to MyClass. |
214 | ... |
215 | } |
216 | |
217 | sub Good : ATTR(ARRAY) { |
218 | # Invoked for any array variable with a :Good attribute, |
219 | # provided the variable was declared in MyClass (or |
220 | # a derived class) or typed to MyClass. |
221 | ... |
222 | } |
223 | |
224 | sub Good : ATTR(HASH) { |
225 | # Invoked for any hash variable with a :Good attribute, |
226 | # provided the variable was declared in MyClass (or |
227 | # a derived class) or typed to MyClass. |
228 | ... |
229 | } |
230 | |
231 | sub Ugly : ATTR(CODE) { |
232 | # Invoked for any subroutine declared in MyClass (or a |
233 | # derived class) with an :Ugly attribute. |
234 | ... |
235 | } |
236 | |
237 | sub Omni : ATTR { |
238 | # Invoked for any scalar, array, hash, or subroutine |
239 | # with an :Omni attribute, provided the variable or |
240 | # subroutine was declared in MyClass (or a derived class) |
241 | # or the variable was typed to MyClass. |
242 | # Use ref($_[2]) to determine what kind of referent it was. |
243 | ... |
244 | } |
245 | |
246 | |
247 | use Attribute::Handlers autotie => { Cycle => Tie::Cycle }; |
248 | |
249 | my $next : Cycle(['A'..'Z']); |
250 | |
251 | |
252 | =head1 DESCRIPTION |
253 | |
254 | This module, when inherited by a package, allows that package's class to |
255 | define attribute handler subroutines for specific attributes. Variables |
256 | and subroutines subsequently defined in that package, or in packages |
257 | derived from that package may be given attributes with the same names as |
9df0c874 |
258 | the attribute handler subroutines, which will then be called in one of |
259 | the compilation phases (i.e. in a C<BEGIN>, C<CHECK>, C<INIT>, or C<END> |
260 | block). |
dc6b6eef |
261 | |
262 | To create a handler, define it as a subroutine with the same name as |
263 | the desired attribute, and declare the subroutine itself with the |
264 | attribute C<:ATTR>. For example: |
265 | |
266 | package LoudDecl; |
267 | use Attribute::Handlers; |
268 | |
269 | sub Loud :ATTR { |
9df0c874 |
270 | my ($package, $symbol, $referent, $attr, $data, $phase) = @_; |
dc6b6eef |
271 | print STDERR |
272 | ref($referent), " ", |
273 | *{$symbol}{NAME}, " ", |
274 | "($referent) ", "was just declared ", |
275 | "and ascribed the ${attr} attribute ", |
9df0c874 |
276 | "with data ($data)\n", |
277 | "in phase $phase\n"; |
dc6b6eef |
278 | } |
279 | |
280 | This creates an handler for the attribute C<:Loud> in the class LoudDecl. |
281 | Thereafter, any subroutine declared with a C<:Loud> attribute in the class |
282 | LoudDecl: |
283 | |
284 | package LoudDecl; |
285 | |
286 | sub foo: Loud {...} |
287 | |
288 | causes the above handler to be invoked, and passed: |
289 | |
290 | =over |
291 | |
292 | =item [0] |
293 | |
294 | the name of the package into which it was declared; |
295 | |
296 | =item [1] |
297 | |
298 | a reference to the symbol table entry (typeglob) containing the subroutine; |
299 | |
300 | =item [2] |
301 | |
302 | a reference to the subroutine; |
303 | |
304 | =item [3] |
305 | |
306 | the name of the attribute; |
307 | |
308 | =item [4] |
309 | |
9df0c874 |
310 | any data associated with that attribute; |
311 | |
312 | =item [5] |
313 | |
314 | the name of the phase in which the handler is being invoked. |
dc6b6eef |
315 | |
316 | =back |
317 | |
318 | Likewise, declaring any variables with the C<:Loud> attribute within the |
319 | package: |
320 | |
9df0c874 |
321 | package LoudDecl; |
dc6b6eef |
322 | |
9df0c874 |
323 | my $foo :Loud; |
324 | my @foo :Loud; |
325 | my %foo :Loud; |
dc6b6eef |
326 | |
327 | will cause the handler to be called with a similar argument list (except, |
328 | of course, that C<$_[2]> will be a reference to the variable). |
329 | |
330 | The package name argument will typically be the name of the class into |
331 | which the subroutine was declared, but it may also be the name of a derived |
332 | class (since handlers are inherited). |
333 | |
334 | If a lexical variable is given an attribute, there is no symbol table to |
335 | which it belongs, so the symbol table argument (C<$_[1]>) is set to the |
336 | string C<'LEXICAL'> in that case. Likewise, ascribing an attribute to |
337 | an anonymous subroutine results in a symbol table argument of C<'ANON'>. |
338 | |
339 | The data argument passes in the value (if any) associated with the |
340 | attribute. For example, if C<&foo> had been declared: |
341 | |
9df0c874 |
342 | sub foo :Loud("turn it up to 11, man!") {...} |
dc6b6eef |
343 | |
344 | then the string C<"turn it up to 11, man!"> would be passed as the |
345 | last argument. |
346 | |
347 | Attribute::Handlers makes strenuous efforts to convert |
348 | the data argument (C<$_[4]>) to a useable form before passing it to |
349 | the handler (but see L<"Non-interpretive attribute handlers">). |
350 | For example, all of these: |
351 | |
9df0c874 |
352 | sub foo :Loud(till=>ears=>are=>bleeding) {...} |
353 | sub foo :Loud(['till','ears','are','bleeding']) {...} |
354 | sub foo :Loud(qw/till ears are bleeding/) {...} |
355 | sub foo :Loud(qw/my, ears, are, bleeding/) {...} |
356 | sub foo :Loud(till,ears,are,bleeding) {...} |
dc6b6eef |
357 | |
358 | causes it to pass C<['till','ears','are','bleeding']> as the handler's |
359 | data argument. However, if the data can't be parsed as valid Perl, then |
360 | it is passed as an uninterpreted string. For example: |
361 | |
9df0c874 |
362 | sub foo :Loud(my,ears,are,bleeding) {...} |
363 | sub foo :Loud(qw/my ears are bleeding) {...} |
dc6b6eef |
364 | |
365 | cause the strings C<'my,ears,are,bleeding'> and C<'qw/my ears are bleeding'> |
366 | respectively to be passed as the data argument. |
367 | |
368 | If the attribute has only a single associated scalar data value, that value is |
369 | passed as a scalar. If multiple values are associated, they are passed as an |
370 | array reference. If no value is associated with the attribute, C<undef> is |
371 | passed. |
372 | |
373 | |
374 | =head2 Typed lexicals |
375 | |
376 | Regardless of the package in which it is declared, if a lexical variable is |
377 | ascribed an attribute, the handler that is invoked is the one belonging to |
378 | the package to which it is typed. For example, the following declarations: |
379 | |
9df0c874 |
380 | package OtherClass; |
dc6b6eef |
381 | |
9df0c874 |
382 | my LoudDecl $loudobj : Loud; |
383 | my LoudDecl @loudobjs : Loud; |
384 | my LoudDecl %loudobjex : Loud; |
dc6b6eef |
385 | |
386 | causes the LoudDecl::Loud handler to be invoked (even if OtherClass also |
387 | defines a handler for C<:Loud> attributes). |
388 | |
389 | |
390 | =head2 Type-specific attribute handlers |
391 | |
392 | If an attribute handler is declared and the C<:ATTR> specifier is |
393 | given the name of a built-in type (C<SCALAR>, C<ARRAY>, C<HASH>, or C<CODE>), |
394 | the handler is only applied to declarations of that type. For example, |
395 | the following definition: |
396 | |
9df0c874 |
397 | package LoudDecl; |
dc6b6eef |
398 | |
9df0c874 |
399 | sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" } |
dc6b6eef |
400 | |
401 | creates an attribute handler that applies only to scalars: |
402 | |
403 | |
9df0c874 |
404 | package Painful; |
405 | use base LoudDecl; |
dc6b6eef |
406 | |
9df0c874 |
407 | my $metal : RealLoud; # invokes &LoudDecl::RealLoud |
408 | my @metal : RealLoud; # error: unknown attribute |
409 | my %metal : RealLoud; # error: unknown attribute |
410 | sub metal : RealLoud {...} # error: unknown attribute |
dc6b6eef |
411 | |
412 | You can, of course, declare separate handlers for these types as well |
413 | (but you'll need to specify C<no warnings 'redefine'> to do it quietly): |
414 | |
9df0c874 |
415 | package LoudDecl; |
416 | use Attribute::Handlers; |
417 | no warnings 'redefine'; |
dc6b6eef |
418 | |
9df0c874 |
419 | sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" } |
420 | sub RealLoud :ATTR(ARRAY) { print "Urrrrrrrrrr!" } |
421 | sub RealLoud :ATTR(HASH) { print "Arrrrrgggghhhhhh!" } |
422 | sub RealLoud :ATTR(CODE) { croak "Real loud sub torpedoed" } |
dc6b6eef |
423 | |
424 | You can also explicitly indicate that a single handler is meant to be |
425 | used for all types of referents like so: |
426 | |
9df0c874 |
427 | package LoudDecl; |
428 | use Attribute::Handlers; |
dc6b6eef |
429 | |
9df0c874 |
430 | sub SeriousLoud :ATTR(ANY) { warn "Hearing loss imminent" } |
dc6b6eef |
431 | |
432 | (I.e. C<ATTR(ANY)> is a synonym for C<:ATTR>). |
433 | |
434 | |
435 | =head2 Non-interpretive attribute handlers |
436 | |
437 | Occasionally the strenuous efforts Attribute::Handlers makes to convert |
438 | the data argument (C<$_[4]>) to a useable form before passing it to |
439 | the handler get in the way. |
440 | |
441 | You can turn off that eagerness-to-help by declaring |
442 | an attribute handler with the the keyword C<RAWDATA>. For example: |
443 | |
9df0c874 |
444 | sub Raw : ATTR(RAWDATA) {...} |
445 | sub Nekkid : ATTR(SCALAR,RAWDATA) {...} |
446 | sub Au::Naturale : ATTR(RAWDATA,ANY) {...} |
dc6b6eef |
447 | |
448 | Then the handler makes absolutely no attempt to interpret the data it |
449 | receives and simply passes it as a string: |
450 | |
9df0c874 |
451 | my $power : Raw(1..100); # handlers receives "1..100" |
452 | |
453 | =head2 Phase-specific attribute handlers |
454 | |
455 | By default, attribute handlers are called at the end of the compilation |
456 | phase (in a C<CHECK> block). This seems to be optimal in most cases because |
457 | most things that can be defined are defined by that point but nothing has |
458 | been executed. |
459 | |
460 | However, it is possible to set up attribute handlers that are called at |
461 | other points in the program's compilation or execution, by explicitly |
462 | stating the phase (or phases) in which you wish the attribute handler to |
463 | be called. For example: |
464 | |
465 | sub Early :ATTR(SCALAR,BEGIN) {...} |
466 | sub Normal :ATTR(SCALAR,CHECK) {...} |
467 | sub Late :ATTR(SCALAR,INIT) {...} |
468 | sub Final :ATTR(SCALAR,END) {...} |
469 | sub Bookends :ATTR(SCALAR,BEGIN,END) {...} |
470 | |
471 | As the last example indicates, a handler may be set up to be (re)called in |
472 | two or more phases. The phase name is passed as the handler's final argument. |
473 | |
474 | Note that attribute handlers that are scheduled for the C<BEGIN> phase |
475 | are handled as soon as the attribute is detected (i.e. before any |
476 | subsequently defined C<BEGIN> blocks are executed). |
dc6b6eef |
477 | |
478 | |
479 | =head2 Attributes as C<tie> interfaces |
480 | |
481 | Attributes make an excellent and intuitive interface through which to tie |
482 | variables. For example: |
483 | |
484 | use Attribute::Handlers; |
485 | use Tie::Cycle; |
486 | |
487 | sub UNIVERSAL::Cycle : ATTR(SCALAR) { |
9df0c874 |
488 | my ($package, $symbol, $referent, $attr, $data, $phase) = @_; |
dc6b6eef |
489 | $data = [ $data ] unless ref $data eq 'ARRAY'; |
490 | tie $$referent, 'Tie::Cycle', $data; |
491 | } |
492 | |
493 | # and thereafter... |
494 | |
495 | package main; |
496 | |
9df0c874 |
497 | my $next : Cycle('A'..'Z'); # $next is now a tied variable |
dc6b6eef |
498 | |
499 | while (<>) { |
500 | print $next; |
501 | } |
502 | |
503 | In fact, this pattern is so widely applicable that Attribute::Handlers |
504 | provides a way to automate it: specifying C<'autotie'> in the |
505 | C<use Attribute::Handlers> statement. So, the previous example, |
506 | could also be written: |
507 | |
508 | use Attribute::Handlers autotie => { Cycle => 'Tie::Cycle' }; |
509 | |
510 | # and thereafter... |
511 | |
512 | package main; |
513 | |
9df0c874 |
514 | my $next : Cycle('A'..'Z'); # $next is now a tied variable |
dc6b6eef |
515 | |
516 | while (<>) { |
517 | print $next; |
518 | |
519 | The argument after C<'autotie'> is a reference to a hash in which each key is |
520 | the name of an attribute to be created, and each value is the class to which |
521 | variables ascribed that attribute should be tied. |
522 | |
523 | Note that there is no longer any need to import the Tie::Cycle module -- |
9df0c874 |
524 | Attribute::Handlers takes care of that automagically. You can even pass |
525 | arguments to the module's C<import> subroutine, by appending them to the |
526 | class name. For example: |
527 | |
528 | use Attribute::Handlers |
529 | autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' }; |
dc6b6eef |
530 | |
531 | If the attribute name is unqualified, the attribute is installed in the |
532 | current package. Otherwise it is installed in the qualifier's package: |
533 | |
dc6b6eef |
534 | package Here; |
535 | |
536 | use Attribute::Handlers autotie => { |
537 | Other::Good => Tie::SecureHash, # tie attr installed in Other:: |
538 | Bad => Tie::Taxes, # tie attr installed in Here:: |
539 | UNIVERSAL::Ugly => Software::Patent # tie attr installed everywhere |
540 | }; |
541 | |
9df0c874 |
542 | Autoties are most commonly used in the module to which they actually tie, |
543 | and need to export their attributes to any module that calls them. To |
544 | facilitiate this, Attribute::Handlers recognizes a special "pseudo-class" -- |
545 | C<__CALLER__>, which may be specified as the qualifier of an attribute: |
546 | |
547 | package Tie::Me::Kangaroo:Down::Sport; |
548 | |
549 | use Attribute::Handler autotie => { __CALLER__::Roo => __PACKAGE__ }; |
550 | |
551 | This causes Attribute::Handlers to define the C<Roo> attribute in the package |
552 | that imports the Tie::Me::Kangaroo:Down::Sport module. |
553 | |
dc6b6eef |
554 | |
555 | =head1 EXAMPLES |
556 | |
557 | If the class shown in L<SYNOPSIS> were placed in the MyClass.pm |
558 | module, then the following code: |
559 | |
560 | package main; |
561 | use MyClass; |
562 | |
563 | my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous); |
564 | |
565 | package SomeOtherClass; |
566 | use base MyClass; |
567 | |
568 | sub tent { 'acle' } |
569 | |
570 | sub fn :Ugly(sister) :Omni('po',tent()) {...} |
571 | my @arr :Good :Omni(s/cie/nt/); |
572 | my %hsh :Good(q/bye) :Omni(q/bus/); |
573 | |
574 | |
575 | would cause the following handlers to be invoked: |
576 | |
577 | # my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous); |
578 | |
579 | MyClass::Good:ATTR(SCALAR)( 'MyClass', # class |
580 | 'LEXICAL', # no typeglob |
581 | \$slr, # referent |
582 | 'Good', # attr name |
583 | undef # no attr data |
9df0c874 |
584 | 'CHECK', # compiler phase |
dc6b6eef |
585 | ); |
586 | |
587 | MyClass::Bad:ATTR(SCALAR)( 'MyClass', # class |
588 | 'LEXICAL', # no typeglob |
589 | \$slr, # referent |
590 | 'Bad', # attr name |
591 | 0 # eval'd attr data |
9df0c874 |
592 | 'CHECK', # compiler phase |
dc6b6eef |
593 | ); |
594 | |
595 | MyClass::Omni:ATTR(SCALAR)( 'MyClass', # class |
596 | 'LEXICAL', # no typeglob |
597 | \$slr, # referent |
598 | 'Omni', # attr name |
599 | '-vorous' # eval'd attr data |
9df0c874 |
600 | 'CHECK', # compiler phase |
dc6b6eef |
601 | ); |
602 | |
603 | |
604 | # sub fn :Ugly(sister) :Omni('po',tent()) {...} |
605 | |
606 | MyClass::UGLY:ATTR(CODE)( 'SomeOtherClass', # class |
607 | \*SomeOtherClass::fn, # typeglob |
608 | \&SomeOtherClass::fn, # referent |
609 | 'Ugly', # attr name |
610 | 'sister' # eval'd attr data |
9df0c874 |
611 | 'CHECK', # compiler phase |
dc6b6eef |
612 | ); |
613 | |
614 | MyClass::Omni:ATTR(CODE)( 'SomeOtherClass', # class |
615 | \*SomeOtherClass::fn, # typeglob |
616 | \&SomeOtherClass::fn, # referent |
617 | 'Omni', # attr name |
618 | ['po','acle'] # eval'd attr data |
9df0c874 |
619 | 'CHECK', # compiler phase |
dc6b6eef |
620 | ); |
621 | |
622 | |
623 | # my @arr :Good :Omni(s/cie/nt/); |
624 | |
625 | MyClass::Good:ATTR(ARRAY)( 'SomeOtherClass', # class |
626 | 'LEXICAL', # no typeglob |
627 | \@arr, # referent |
628 | 'Good', # attr name |
629 | undef # no attr data |
9df0c874 |
630 | 'CHECK', # compiler phase |
dc6b6eef |
631 | ); |
632 | |
633 | MyClass::Omni:ATTR(ARRAY)( 'SomeOtherClass', # class |
634 | 'LEXICAL', # no typeglob |
635 | \@arr, # referent |
636 | 'Omni', # attr name |
637 | "" # eval'd attr data |
9df0c874 |
638 | 'CHECK', # compiler phase |
dc6b6eef |
639 | ); |
640 | |
641 | |
642 | # my %hsh :Good(q/bye) :Omni(q/bus/); |
643 | |
644 | MyClass::Good:ATTR(HASH)( 'SomeOtherClass', # class |
645 | 'LEXICAL', # no typeglob |
646 | \%hsh, # referent |
647 | 'Good', # attr name |
648 | 'q/bye' # raw attr data |
9df0c874 |
649 | 'CHECK', # compiler phase |
dc6b6eef |
650 | ); |
651 | |
652 | MyClass::Omni:ATTR(HASH)( 'SomeOtherClass', # class |
653 | 'LEXICAL', # no typeglob |
654 | \%hsh, # referent |
655 | 'Omni', # attr name |
656 | 'bus' # eval'd attr data |
9df0c874 |
657 | 'CHECK', # compiler phase |
dc6b6eef |
658 | ); |
659 | |
660 | |
661 | Installing handlers into UNIVERSAL, makes them...err..universal. |
662 | For example: |
663 | |
9df0c874 |
664 | package Descriptions; |
665 | use Attribute::Handlers; |
dc6b6eef |
666 | |
9df0c874 |
667 | my %name; |
668 | sub name { return $name{$_[2]}||*{$_[1]}{NAME} } |
dc6b6eef |
669 | |
9df0c874 |
670 | sub UNIVERSAL::Name :ATTR { |
671 | $name{$_[2]} = $_[4]; |
672 | } |
dc6b6eef |
673 | |
9df0c874 |
674 | sub UNIVERSAL::Purpose :ATTR { |
675 | print STDERR "Purpose of ", &name, " is $_[4]\n"; |
676 | } |
dc6b6eef |
677 | |
9df0c874 |
678 | sub UNIVERSAL::Unit :ATTR { |
679 | print STDERR &name, " measured in $_[4]\n"; |
680 | } |
dc6b6eef |
681 | |
682 | Let's you write: |
683 | |
9df0c874 |
684 | use Descriptions; |
dc6b6eef |
685 | |
9df0c874 |
686 | my $capacity : Name(capacity) |
687 | : Purpose(to store max storage capacity for files) |
688 | : Unit(Gb); |
dc6b6eef |
689 | |
690 | |
9df0c874 |
691 | package Other; |
dc6b6eef |
692 | |
9df0c874 |
693 | sub foo : Purpose(to foo all data before barring it) { } |
dc6b6eef |
694 | |
9df0c874 |
695 | # etc. |
dc6b6eef |
696 | |
697 | |
698 | =head1 DIAGNOSTICS |
699 | |
700 | =over |
701 | |
9df0c874 |
702 | =item C<Bad attribute type: ATTR(%s)> |
dc6b6eef |
703 | |
704 | An attribute handler was specified with an C<:ATTR(I<ref_type>)>, but the |
705 | type of referent it was defined to handle wasn't one of the five permitted: |
706 | C<SCALAR>, C<ARRAY>, C<HASH>, C<CODE>, or C<ANY>. |
707 | |
9df0c874 |
708 | =item C<Attribute handler %s doesn't handle %s attributes> |
dc6b6eef |
709 | |
710 | A handler for attributes of the specified name I<was> defined, but not |
711 | for the specified type of declaration. Typically encountered whe trying |
712 | to apply a C<VAR> attribute handler to a subroutine, or a C<SCALAR> |
713 | attribute handler to some other type of variable. |
714 | |
9df0c874 |
715 | =item C<Declaration of %s attribute in package %s may clash with future reserved word> |
dc6b6eef |
716 | |
717 | A handler for an attributes with an all-lowercase name was declared. An |
718 | attribute with an all-lowercase name might have a meaning to Perl |
719 | itself some day, even though most don't yet. Use a mixed-case attribute |
720 | name, instead. |
721 | |
9df0c874 |
722 | =item C<Can't have two ATTR specifiers on one subroutine> |
723 | |
724 | You just can't, okay? |
725 | Instead, put all the specifications together with commas between them |
726 | in a single C<ATTR(I<specification>)>. |
727 | |
728 | =item C<Can't autotie a %s> |
729 | |
730 | You can only declare autoties for types C<"SCALAR">, C<"ARRAY">, and |
731 | C<"SCALAR">. They're the only things (apart from typeglobs -- which are |
732 | not declarable) that Perl can tie. |
0addb26a |
733 | |
9df0c874 |
734 | =item C<Internal error: %s symbol went missing> |
dc6b6eef |
735 | |
736 | Something is rotten in the state of the program. An attributed |
9df0c874 |
737 | subroutine ceased to exist between the point it was declared and the point |
738 | at which its attribute handler(s) would have been called. |
dc6b6eef |
739 | |
740 | =back |
741 | |
742 | =head1 AUTHOR |
743 | |
744 | Damian Conway (damian@conway.org) |
745 | |
746 | =head1 BUGS |
747 | |
748 | There are undoubtedly serious bugs lurking somewhere in code this funky :-) |
749 | Bug reports and other feedback are most welcome. |
750 | |
751 | =head1 COPYRIGHT |
752 | |
753 | Copyright (c) 2001, Damian Conway. All Rights Reserved. |
754 | This module is free software. It may be used, redistributed |
755 | and/or modified under the terms of the Perl Artistic License |
756 | (see http://www.perl.com/perl/misc/Artistic.html) |