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