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