lib/Attribute/Handlers.pm

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