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