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