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