lib/Attribute/Handlers.pm

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