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