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