This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix Attribute::Handlers pod to match new $VERSION
[perl5.git] / dist / Attribute-Handlers / lib / Attribute / Handlers.pm
CommitLineData
0e9b9e0c
JH
1package Attribute::Handlers;
2use 5.006;
3use Carp;
4use warnings;
d6e4b61b 5use strict;
1a58b39a
N
6our $AUTOLOAD;
7our $VERSION = '1.01'; # remember to update version in POD!
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);
d6e4b61b 15 no strict 'refs';
7a11f5c3
FC
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 }
d6e4b61b 21 use strict;
39c882db 22 next unless ref ( \$sym ) eq 'GLOB';
0e9b9e0c
JH
23 return $symcache{$pkg,$ref} = \$sym
24 if *{$sym}{$type} && *{$sym}{$type} == $ref;
7a11f5c3 25 }}
0e9b9e0c
JH
26}
27
28my %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);
37my %lastattr;
38my @declarations;
39my %raw;
40my %phase;
41my %sigil = (SCALAR=>'$', ARRAY=>'@', HASH=>'%');
42my $global_phase = 0;
43my %global_phases = (
44 BEGIN => 0,
45 CHECK => 1,
46 INIT => 2,
47 END => 3,
48);
49my @global_phases = qw(BEGIN CHECK INIT END);
50
51sub _usage_AH_ {
52 croak "Usage: use $_[0] autotie => {AttrName => TieClassName,...}";
53}
54
55my $qual_id = qr/^[_a-z]\w*(::[_a-z]\w*)*$/i;
56
57sub 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
d6e4b61b 71 && eval "use base q\0$tieclass\0; 1";
0e9b9e0c
JH
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}
09330df8
Z
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.
108BEGIN {
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
0e9b9e0c
JH
120sub _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}}} ) {
d6e4b61b 128 no strict 'refs';
0e9b9e0c
JH
129 *{"$lastattr{pkg}::_ATTR_${_}_${name}"} = $lastattr{ref};
130 }
131 %lastattr = ();
132}
133
134sub AUTOLOAD {
ac8e8084 135 return if $AUTOLOAD =~ /::DESTROY$/;
0e9b9e0c
JH
136 my ($class) = $AUTOLOAD =~ m/(.*)::/g;
137 $AUTOLOAD =~ m/_ATTR_(.*?)_(.*)/ or
138 croak "Can't locate class method '$AUTOLOAD' via package '$class'";
4da5364c 139 croak "Attribute handler '$2' doesn't handle $1 attributes";
0e9b9e0c
JH
140}
141
cfdc35fc 142my $builtin = $] ge '5.027000'
01cb6455 143 ? qr/lvalue|method|shared/
cfdc35fc 144 : qr/lvalue|method|locked|shared|unique/;
0e9b9e0c
JH
145
146sub _gen_handler_AH_() {
147 return sub {
09330df8 148 _resolve_lastattr if _delayed_name_resolution;
0e9b9e0c 149 my ($pkg, $ref, @attrs) = @_;
cab6c672 150 my (undef, $filename, $linenum) = caller 2;
0e9b9e0c
JH
151 foreach (@attrs) {
152 my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next;
153 if ($attr eq 'ATTR') {
d6e4b61b 154 no strict 'refs';
0e9b9e0c
JH
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);
09330df8 173 _resolve_lastattr unless _delayed_name_resolution;
0e9b9e0c
JH
174 }
175 else {
c760c918
RC
176 my $type = ref $ref;
177 my $handler = $pkg->can("_ATTR_${type}_${attr}");
0e9b9e0c
JH
178 next unless $handler;
179 my $decl = [$pkg, $ref, $attr, $data,
cab6c672 180 $raw{$handler}, $phase{$handler}, $filename, $linenum];
0e9b9e0c
JH
181 foreach my $gphase (@global_phases) {
182 _apply_handler_AH_($decl,$gphase)
183 if $global_phases{$gphase} <= $global_phase;
184 }
24952a9c
RC
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 }
0e9b9e0c
JH
197 }
198 $_ = undef;
199 }
200 return grep {defined && !/$builtin/} @attrs;
201 }
202}
203
d6e4b61b
NC
204{
205 no strict 'refs';
206 *{"Attribute::Handlers::UNIVERSAL::MODIFY_${_}_ATTRIBUTES"} =
207 _gen_handler_AH_ foreach @{$validtype{ANY}};
208}
290b54b8
AF
209push @UNIVERSAL::ISA, 'Attribute::Handlers::UNIVERSAL'
210 unless grep /^Attribute::Handlers::UNIVERSAL$/, @UNIVERSAL::ISA;
0e9b9e0c
JH
211
212sub _apply_handler_AH_ {
213 my ($declaration, $phase) = @_;
cab6c672 214 my ($pkg, $ref, $attr, $data, $raw, $handlerphase, $filename, $linenum) = @$declaration;
0e9b9e0c
JH
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;
b384a05d
SB
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 }
0e9b9e0c
JH
230 $pkg->$handler($sym,
231 (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
232 $attr,
2560d050 233 $data,
0e9b9e0c 234 $phase,
cab6c672
DF
235 $filename,
236 $linenum,
0e9b9e0c
JH
237 );
238 return 1;
239}
240
ba690e32
AB
241{
242 no warnings 'void';
243 CHECK {
f2ea78b6
CBW
244 $global_phase++;
245 _resolve_lastattr if _delayed_name_resolution;
246 foreach my $decl (@declarations) {
247 _apply_handler_AH_($decl, 'CHECK');
248 }
ba690e32 249 }
0e9b9e0c 250
ba690e32
AB
251 INIT {
252 $global_phase++;
f2ea78b6
CBW
253 foreach my $decl (@declarations) {
254 _apply_handler_AH_($decl, 'INIT');
255 }
ba690e32
AB
256 }
257}
0e9b9e0c 258
f2ea78b6
CBW
259END {
260 $global_phase++;
261 foreach my $decl (@declarations) {
262 _apply_handler_AH_($decl, 'END');
263 }
264}
0e9b9e0c
JH
265
2661;
267__END__
268
269=head1 NAME
270
271Attribute::Handlers - Simpler definition of attribute handlers
272
273=head1 VERSION
274
3ee38754 275This document describes version 1.01 of Attribute::Handlers.
0e9b9e0c
JH
276
277=head1 SYNOPSIS
278
ed742281
FC
279 package MyClass;
280 require 5.006;
281 use Attribute::Handlers;
282 no warnings 'redefine';
0e9b9e0c
JH
283
284
ed742281
FC
285 sub Good : ATTR(SCALAR) {
286 my ($package, $symbol, $referent, $attr, $data) = @_;
0e9b9e0c 287
ed742281
FC
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.
0e9b9e0c 291
ed742281
FC
292 # Do whatever to $referent here (executed in CHECK phase).
293 ...
294 }
0e9b9e0c 295
ed742281
FC
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 }
0e9b9e0c 302
ed742281
FC
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 }
0e9b9e0c 309
ed742281
FC
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 }
0e9b9e0c 316
ed742281
FC
317 sub Ugly : ATTR(CODE) {
318 # Invoked for any subroutine declared in MyClass (or a
319 # derived class) with an :Ugly attribute.
320 ...
321 }
0e9b9e0c 322
ed742281
FC
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 }
0e9b9e0c
JH
331
332
ed742281 333 use Attribute::Handlers autotie => { Cycle => Tie::Cycle };
0e9b9e0c 334
ed742281 335 my $next : Cycle(['A'..'Z']);
0e9b9e0c
JH
336
337
338=head1 DESCRIPTION
339
340This module, when inherited by a package, allows that package's class to
341define attribute handler subroutines for specific attributes. Variables
342and subroutines subsequently defined in that package, or in packages
343derived from that package may be given attributes with the same names as
344the attribute handler subroutines, which will then be called in one of
345the compilation phases (i.e. in a C<BEGIN>, C<CHECK>, C<INIT>, or C<END>
6d9eb87b
RGS
346block). (C<UNITCHECK> blocks don't correspond to a global compilation
347phase, so they can't be specified here.)
0e9b9e0c
JH
348
349To create a handler, define it as a subroutine with the same name as
350the desired attribute, and declare the subroutine itself with the
351attribute C<:ATTR>. For example:
352
cab6c672
DF
353 package LoudDecl;
354 use Attribute::Handlers;
355
356 sub Loud :ATTR {
ed742281
FC
357 my ($package, $symbol, $referent, $attr, $data, $phase,
358 $filename, $linenum) = @_;
cab6c672
DF
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 }
0e9b9e0c
JH
368
369This creates a handler for the attribute C<:Loud> in the class LoudDecl.
370Thereafter, any subroutine declared with a C<:Loud> attribute in the class
371LoudDecl:
372
ed742281 373 package LoudDecl;
f703fc96 374
ed742281 375 sub foo: Loud {...}
0e9b9e0c
JH
376
377causes the above handler to be invoked, and passed:
378
379=over
380
381=item [0]
382
383the name of the package into which it was declared;
384
385=item [1]
386
387a reference to the symbol table entry (typeglob) containing the subroutine;
388
389=item [2]
390
391a reference to the subroutine;
392
393=item [3]
394
395the name of the attribute;
396
397=item [4]
398
399any data associated with that attribute;
400
401=item [5]
402
cab6c672
DF
403the name of the phase in which the handler is being invoked;
404
405=item [6]
406
407the filename in which the handler is being invoked;
408
409=item [7]
410
411the line number in this file.
0e9b9e0c
JH
412
413=back
414
415Likewise, declaring any variables with the C<:Loud> attribute within the
416package:
417
ed742281 418 package LoudDecl;
0e9b9e0c 419
ed742281
FC
420 my $foo :Loud;
421 my @foo :Loud;
422 my %foo :Loud;
0e9b9e0c
JH
423
424will cause the handler to be called with a similar argument list (except,
425of course, that C<$_[2]> will be a reference to the variable).
426
427The package name argument will typically be the name of the class into
428which the subroutine was declared, but it may also be the name of a derived
429class (since handlers are inherited).
430
431If a lexical variable is given an attribute, there is no symbol table to
432which it belongs, so the symbol table argument (C<$_[1]>) is set to the
433string C<'LEXICAL'> in that case. Likewise, ascribing an attribute to
434an anonymous subroutine results in a symbol table argument of C<'ANON'>.
435
2560d050 436The data argument passes in the value (if any) associated with the
0e9b9e0c
JH
437attribute. For example, if C<&foo> had been declared:
438
439 sub foo :Loud("turn it up to 11, man!") {...}
440
2560d050
DC
441then a reference to an array containing the string
442C<"turn it up to 11, man!"> would be passed as the last argument.
0e9b9e0c
JH
443
444Attribute::Handlers makes strenuous efforts to convert
ca2796bf 445the data argument (C<$_[4]>) to a usable form before passing it to
0e9b9e0c 446the handler (but see L<"Non-interpretive attribute handlers">).
2560d050
DC
447If those efforts succeed, the interpreted data is passed in an array
448reference; if they fail, the raw data is passed as a string.
0e9b9e0c
JH
449For example, all of these:
450
2560d050
DC
451 sub foo :Loud(till=>ears=>are=>bleeding) {...}
452 sub foo :Loud(qw/till ears are bleeding/) {...}
78973a2c 453 sub foo :Loud(qw/till, ears, are, bleeding/) {...}
2560d050 454 sub foo :Loud(till,ears,are,bleeding) {...}
0e9b9e0c
JH
455
456causes it to pass C<['till','ears','are','bleeding']> as the handler's
2560d050
DC
457data argument. While:
458
459 sub foo :Loud(['till','ears','are','bleeding']) {...}
0e9b9e0c 460
2560d050
DC
461causes it to pass C<[ ['till','ears','are','bleeding'] ]>; the array
462reference specified in the data being passed inside the standard
463array reference indicating successful interpretation.
464
465However, if the data can't be parsed as valid Perl, then
466it is passed as an uninterpreted string. For example:
0e9b9e0c 467
2560d050
DC
468 sub foo :Loud(my,ears,are,bleeding) {...}
469 sub foo :Loud(qw/my ears are bleeding) {...}
0e9b9e0c 470
2560d050
DC
471cause the strings C<'my,ears,are,bleeding'> and
472C<'qw/my ears are bleeding'> respectively to be passed as the
473data argument.
0e9b9e0c 474
2560d050 475If no value is associated with the attribute, C<undef> is passed.
0e9b9e0c
JH
476
477=head2 Typed lexicals
478
479Regardless of the package in which it is declared, if a lexical variable is
480ascribed an attribute, the handler that is invoked is the one belonging to
481the package to which it is typed. For example, the following declarations:
482
ed742281 483 package OtherClass;
0e9b9e0c 484
ed742281
FC
485 my LoudDecl $loudobj : Loud;
486 my LoudDecl @loudobjs : Loud;
487 my LoudDecl %loudobjex : Loud;
0e9b9e0c
JH
488
489causes the LoudDecl::Loud handler to be invoked (even if OtherClass also
490defines a handler for C<:Loud> attributes).
491
492
493=head2 Type-specific attribute handlers
494
495If an attribute handler is declared and the C<:ATTR> specifier is
496given the name of a built-in type (C<SCALAR>, C<ARRAY>, C<HASH>, or C<CODE>),
497the handler is only applied to declarations of that type. For example,
498the following definition:
499
ed742281 500 package LoudDecl;
0e9b9e0c 501
ed742281 502 sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" }
0e9b9e0c
JH
503
504creates an attribute handler that applies only to scalars:
505
506
ed742281
FC
507 package Painful;
508 use base LoudDecl;
0e9b9e0c 509
ed742281
FC
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
0e9b9e0c
JH
514
515You 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
ed742281
FC
518 package LoudDecl;
519 use Attribute::Handlers;
520 no warnings 'redefine';
0e9b9e0c 521
ed742281
FC
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" }
0e9b9e0c
JH
526
527You can also explicitly indicate that a single handler is meant to be
528used for all types of referents like so:
529
ed742281
FC
530 package LoudDecl;
531 use Attribute::Handlers;
0e9b9e0c 532
ed742281 533 sub SeriousLoud :ATTR(ANY) { warn "Hearing loss imminent" }
0e9b9e0c
JH
534
535(I.e. C<ATTR(ANY)> is a synonym for C<:ATTR>).
536
537
538=head2 Non-interpretive attribute handlers
539
540Occasionally the strenuous efforts Attribute::Handlers makes to convert
ca2796bf 541the data argument (C<$_[4]>) to a usable form before passing it to
0e9b9e0c
JH
542the handler get in the way.
543
544You can turn off that eagerness-to-help by declaring
545an attribute handler with the keyword C<RAWDATA>. For example:
546
ed742281
FC
547 sub Raw : ATTR(RAWDATA) {...}
548 sub Nekkid : ATTR(SCALAR,RAWDATA) {...}
549 sub Au::Naturale : ATTR(RAWDATA,ANY) {...}
0e9b9e0c
JH
550
551Then the handler makes absolutely no attempt to interpret the data it
552receives and simply passes it as a string:
553
ed742281 554 my $power : Raw(1..100); # handlers receives "1..100"
0e9b9e0c
JH
555
556=head2 Phase-specific attribute handlers
557
558By default, attribute handlers are called at the end of the compilation
559phase (in a C<CHECK> block). This seems to be optimal in most cases because
560most things that can be defined are defined by that point but nothing has
561been executed.
562
563However, it is possible to set up attribute handlers that are called at
564other points in the program's compilation or execution, by explicitly
565stating the phase (or phases) in which you wish the attribute handler to
566be called. For example:
567
ed742281
FC
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) {...}
0e9b9e0c
JH
573
574As the last example indicates, a handler may be set up to be (re)called in
575two or more phases. The phase name is passed as the handler's final argument.
576
577Note that attribute handlers that are scheduled for the C<BEGIN> phase
578are handled as soon as the attribute is detected (i.e. before any
579subsequently defined C<BEGIN> blocks are executed).
580
581
582=head2 Attributes as C<tie> interfaces
583
584Attributes make an excellent and intuitive interface through which to tie
585variables. For example:
586
ed742281
FC
587 use Attribute::Handlers;
588 use Tie::Cycle;
f703fc96 589
ed742281
FC
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 }
0e9b9e0c 595
ed742281 596 # and thereafter...
0e9b9e0c 597
ed742281 598 package main;
f703fc96 599
ed742281 600 my $next : Cycle('A'..'Z'); # $next is now a tied variable
f703fc96 601
ed742281
FC
602 while (<>) {
603 print $next;
604 }
0e9b9e0c
JH
605
606Note that, because the C<Cycle> attribute receives its arguments in the
607C<$data> variable, if the attribute is given a list of arguments, C<$data>
608will consist of a single array reference; otherwise, it will consist of the
609single argument directly. Since Tie::Cycle requires its cycling values to
610be passed as an array reference, this means that we need to wrap
611non-array-reference arguments in an array constructor:
612
ed742281 613 $data = [ $data ] unless ref $data eq 'ARRAY';
0e9b9e0c
JH
614
615Typically, however, things are the other way around: the tieable class expects
616its arguments as a flattened list, so the attribute looks like:
617
ed742281
FC
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 }
0e9b9e0c
JH
623
624
625This software pattern is so widely applicable that Attribute::Handlers
626provides a way to automate it: specifying C<'autotie'> in the
627C<use Attribute::Handlers> statement. So, the cycling example,
628could also be written:
629
ed742281 630 use Attribute::Handlers autotie => { Cycle => 'Tie::Cycle' };
0e9b9e0c 631
ed742281 632 # and thereafter...
0e9b9e0c 633
ed742281 634 package main;
0e9b9e0c 635
ed742281 636 my $next : Cycle(['A'..'Z']); # $next is now a tied variable
0e9b9e0c 637
ed742281
FC
638 while (<>) {
639 print $next;
640 }
0e9b9e0c
JH
641
642Note that we now have to pass the cycling values as an array reference,
643since 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
645the original Tie::Cycle example at the start of this section).
646
647The argument after C<'autotie'> is a reference to a hash in which each key is
648the name of an attribute to be created, and each value is the class to which
649variables ascribed that attribute should be tied.
650
651Note that there is no longer any need to import the Tie::Cycle module --
652Attribute::Handlers takes care of that automagically. You can even pass
653arguments to the module's C<import> subroutine, by appending them to the
654class name. For example:
655
ed742281
FC
656 use Attribute::Handlers
657 autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' };
0e9b9e0c
JH
658
659If the attribute name is unqualified, the attribute is installed in the
660current package. Otherwise it is installed in the qualifier's package:
661
ed742281 662 package Here;
f703fc96 663
ed742281
FC
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 };
0e9b9e0c
JH
669
670Autoties are most commonly used in the module to which they actually tie,
671and need to export their attributes to any module that calls them. To
3c4b39be 672facilitate this, Attribute::Handlers recognizes a special "pseudo-class" --
0e9b9e0c
JH
673C<__CALLER__>, which may be specified as the qualifier of an attribute:
674
ed742281 675 package Tie::Me::Kangaroo:Down::Sport;
f703fc96 676
ed742281
FC
677 use Attribute::Handlers autotie =>
678 { '__CALLER__::Roo' => __PACKAGE__ };
0e9b9e0c
JH
679
680This causes Attribute::Handlers to define the C<Roo> attribute in the package
681that imports the Tie::Me::Kangaroo:Down::Sport module.
682
f903cfef
AB
683Note that it is important to quote the __CALLER__::Roo identifier because
684a bug in perl 5.8 will refuse to parse it and cause an unknown error.
685
0e9b9e0c
JH
686=head3 Passing the tied object to C<tie>
687
688Occasionally it is important to pass a reference to the object being tied
689to the TIESCALAR, TIEHASH, etc. that ties it.
690
691The C<autotie> mechanism supports this too. The following code:
692
ed742281
FC
693 use Attribute::Handlers autotieref => { Selfish => Tie::Selfish };
694 my $var : Selfish(@args);
0e9b9e0c
JH
695
696has the same effect as:
697
ed742281 698 tie my $var, 'Tie::Selfish', @args;
0e9b9e0c
JH
699
700But when C<"autotieref"> is used instead of C<"autotie">:
701
ed742281
FC
702 use Attribute::Handlers autotieref => { Selfish => Tie::Selfish };
703 my $var : Selfish(@args);
0e9b9e0c
JH
704
705the effect is to pass the C<tie> call an extra reference to the variable
706being tied:
707
ed742281 708 tie my $var, 'Tie::Selfish', \$var, @args;
0e9b9e0c
JH
709
710
711
712=head1 EXAMPLES
713
616e857a 714If the class shown in L</SYNOPSIS> were placed in the MyClass.pm
0e9b9e0c
JH
715module, then the following code:
716
ed742281
FC
717 package main;
718 use MyClass;
0e9b9e0c 719
ed742281 720 my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous);
0e9b9e0c 721
ed742281
FC
722 package SomeOtherClass;
723 use base MyClass;
0e9b9e0c 724
ed742281 725 sub tent { 'acle' }
0e9b9e0c 726
ed742281
FC
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/);
0e9b9e0c
JH
730
731
732would cause the following handlers to be invoked:
733
ed742281
FC
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/);
f703fc96 800
ed742281
FC
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 );
f703fc96 808
ed742281
FC
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 );
0e9b9e0c
JH
816
817
818Installing handlers into UNIVERSAL, makes them...err..universal.
819For example:
820
ed742281
FC
821 package Descriptions;
822 use Attribute::Handlers;
0e9b9e0c 823
ed742281
FC
824 my %name;
825 sub name { return $name{$_[2]}||*{$_[1]}{NAME} }
0e9b9e0c 826
ed742281
FC
827 sub UNIVERSAL::Name :ATTR {
828 $name{$_[2]} = $_[4];
829 }
0e9b9e0c 830
ed742281
FC
831 sub UNIVERSAL::Purpose :ATTR {
832 print STDERR "Purpose of ", &name, " is $_[4]\n";
833 }
0e9b9e0c 834
ed742281
FC
835 sub UNIVERSAL::Unit :ATTR {
836 print STDERR &name, " measured in $_[4]\n";
837 }
0e9b9e0c
JH
838
839Let's you write:
840
ed742281 841 use Descriptions;
0e9b9e0c 842
ed742281
FC
843 my $capacity : Name(capacity)
844 : Purpose(to store max storage capacity for files)
845 : Unit(Gb);
0e9b9e0c
JH
846
847
ed742281 848 package Other;
0e9b9e0c 849
ed742281 850 sub foo : Purpose(to foo all data before barring it) { }
0e9b9e0c 851
ed742281 852 # etc.
0e9b9e0c 853
f2e81f84
DW
854=head1 UTILITY FUNCTIONS
855
856This module offers a single utility function, C<findsym()>.
857
858=over 4
859
860=item findsym
861
ed742281 862 my $symbol = Attribute::Handlers::findsym($package, $referent);
f2e81f84
DW
863
864The function looks in the symbol table of C<$package> for the typeglob for
865C<$referent>, which is a reference to a variable or subroutine (SCALAR, ARRAY,
866HASH, or CODE). If it finds the typeglob, it returns it. Otherwise, it returns
867undef. Note that C<findsym> memoizes the typeglobs it has previously
868successfully found, so subsequent calls with the same arguments should be
56fb04d2 869much faster.
f2e81f84
DW
870
871=back
0e9b9e0c
JH
872
873=head1 DIAGNOSTICS
874
875=over
876
877=item C<Bad attribute type: ATTR(%s)>
878
879An attribute handler was specified with an C<:ATTR(I<ref_type>)>, but the
880type of referent it was defined to handle wasn't one of the five permitted:
881C<SCALAR>, C<ARRAY>, C<HASH>, C<CODE>, or C<ANY>.
882
883=item C<Attribute handler %s doesn't handle %s attributes>
884
885A handler for attributes of the specified name I<was> defined, but not
a0b243e8 886for the specified type of declaration. Typically encountered when trying
0e9b9e0c
JH
887to apply a C<VAR> attribute handler to a subroutine, or a C<SCALAR>
888attribute 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
892A handler for an attributes with an all-lowercase name was declared. An
893attribute with an all-lowercase name might have a meaning to Perl
894itself some day, even though most don't yet. Use a mixed-case attribute
895name, instead.
896
897=item C<Can't have two ATTR specifiers on one subroutine>
898
899You just can't, okay?
900Instead, put all the specifications together with commas between them
901in a single C<ATTR(I<specification>)>.
902
903=item C<Can't autotie a %s>
904
905You can only declare autoties for types C<"SCALAR">, C<"ARRAY">, and
906C<"HASH">. They're the only things (apart from typeglobs -- which are
907not declarable) that Perl can tie.
908
909=item C<Internal error: %s symbol went missing>
910
911Something is rotten in the state of the program. An attributed
912subroutine ceased to exist between the point it was declared and the point
913at which its attribute handler(s) would have been called.
914
24952a9c
RC
915=item C<Won't be able to apply END handler>
916
917You have defined an END handler for an attribute that is being applied
918to a lexical variable. Since the variable may not be available during END
919this won't happen.
920
0e9b9e0c
JH
921=back
922
923=head1 AUTHOR
924
b8e1b25f
NC
925Damian Conway (damian@conway.org). The maintainer of this module is now Rafael
926Garcia-Suarez (rgarciasuarez@gmail.com).
0e9b9e0c 927
2a59936d
S
928Maintainer of the CPAN release is Steffen Mueller (smueller@cpan.org).
929Contact him with technical difficulties with respect to the packaging of the
930CPAN module.
931
0e9b9e0c
JH
932=head1 BUGS
933
934There are undoubtedly serious bugs lurking somewhere in code this funky :-)
935Bug reports and other feedback are most welcome.
936
2a59936d 937=head1 COPYRIGHT AND LICENSE
0e9b9e0c 938
39acff44 939 Copyright (c) 2001-2014, Damian Conway. All Rights Reserved.
0e9b9e0c
JH
940 This module is free software. It may be used, redistributed
941 and/or modified under the same terms as Perl itself.