1N/A croak "Usage: use $_[0] autotie => {AttrName => TieClassName,...}";
1N/A return unless $
class eq "Attribute::Handlers";
1N/A &&
eval "use base $tieclass; 1";
1N/A :
die "Can't autotie a \$type\n" 1N/A }
or die "Internal error: $@";
1N/A croak "Can't understand $_";
1N/A or die "Internal error: $lastattr{pkg} symbol went missing";
1N/A warn "Declaration of $name attribute in package $lastattr{pkg} may clash with future reserved word\n" 1N/A *{
"$lastattr{pkg}::_ATTR_${_}_${name}"} = $
lastattr{
ref};
1N/A croak "Can't locate class method '$AUTOLOAD' via package '$class'";
1N/A croak "Attribute handler '$2' doesn't handle $1 attributes";
1N/A if $
data =~ s/\s*,?\s*(
BEGIN)\s*,?\s*//;
1N/A if $
data =~ s/\s*,?\s*(
INIT)\s*,?\s*//;
1N/A if $
data =~ s/\s*,?\s*(
END)\s*,?\s*//;
1N/A if $
data =~ s/\s*,?\s*(
CHECK)\s*,?\s*//
1N/A # Added for cleanup to not pollute next call. 1N/A croak "Can't have two ATTR specifiers on one subroutine" 1N/A croak "Bad attribute type: ATTR($data)" 1N/A # if _gen_handler_AH_ is being called after 1N/A # CHECK it's for a lexical, so make sure 1N/A # it didn't want to run anything later 1N/A carp "Won't be able to apply END handler" 1N/A*{
"Attribute::Handlers::UNIVERSAL::MODIFY_${_}_ATTRIBUTES"} =
1N/A # print STDERR "Handling $attr on $ref in $phase with [$data]\n"; 1N/AAttribute::Handlers - Simpler definition of attribute handlers 1N/AThis document describes version 0.78 of Attribute::Handlers, 1N/Areleased October 5, 2002. 1N/A use Attribute::Handlers; 1N/A no warnings 'redefine'; 1N/A sub Good : ATTR(SCALAR) { 1N/A my ($package, $symbol, $referent, $attr, $data) = @_; 1N/A # Invoked for any scalar variable with a :Good attribute, 1N/A # provided the variable was declared in MyClass (or 1N/A # a derived class) or typed to MyClass. 1N/A # Do whatever to $referent here (executed in CHECK phase). 1N/A sub Bad : ATTR(SCALAR) { 1N/A # Invoked for any scalar variable with a :Bad attribute, 1N/A # provided the variable was declared in MyClass (or 1N/A # a derived class) or typed to MyClass. 1N/A sub Good : ATTR(ARRAY) { 1N/A # Invoked for any array variable with a :Good attribute, 1N/A # provided the variable was declared in MyClass (or 1N/A # a derived class) or typed to MyClass. 1N/A sub Good : ATTR(HASH) { 1N/A # Invoked for any hash variable with a :Good attribute, 1N/A # provided the variable was declared in MyClass (or 1N/A # a derived class) or typed to MyClass. 1N/A sub Ugly : ATTR(CODE) { 1N/A # Invoked for any subroutine declared in MyClass (or a 1N/A # derived class) with an :Ugly attribute. 1N/A # Invoked for any scalar, array, hash, or subroutine 1N/A # with an :Omni attribute, provided the variable or 1N/A # subroutine was declared in MyClass (or a derived class) 1N/A # or the variable was typed to MyClass. 1N/A # Use ref($_[2]) to determine what kind of referent it was. 1N/A use Attribute::Handlers autotie => { Cycle => Tie::Cycle }; 1N/A my $next : Cycle(['A'..'Z']); 1N/AThis module, when inherited by a package, allows that package's class to 1N/Adefine attribute handler subroutines for specific attributes. Variables 1N/Aand subroutines subsequently defined in that package, or in packages 1N/Aderived from that package may be given attributes with the same names as 1N/Athe attribute handler subroutines, which will then be called in one of 1N/Athe compilation phases (i.e. in a C<BEGIN>, C<CHECK>, C<INIT>, or C<END> 1N/ATo create a handler, define it as a subroutine with the same name as 1N/Athe desired attribute, and declare the subroutine itself with the 1N/Aattribute C<:ATTR>. For example: 1N/A use Attribute::Handlers; 1N/A my ($package, $symbol, $referent, $attr, $data, $phase) = @_; 1N/A ref($referent), " ", 1N/A *{$symbol}{NAME}, " ", 1N/A "($referent) ", "was just declared ", 1N/A "and ascribed the ${attr} attribute ", 1N/A "with data ($data)\n", 1N/A "in phase $phase\n"; 1N/AThis creates a handler for the attribute C<:Loud> in the class LoudDecl. 1N/AThereafter, any subroutine declared with a C<:Loud> attribute in the class 1N/Acauses the above handler to be invoked, and passed: 1N/Athe name of the package into which it was declared; 1N/Aa reference to the symbol table entry (typeglob) containing the subroutine; 1N/Aa reference to the subroutine; 1N/Athe name of the attribute; 1N/Aany data associated with that attribute; 1N/Athe name of the phase in which the handler is being invoked. 1N/ALikewise, declaring any variables with the C<:Loud> attribute within the 1N/Awill cause the handler to be called with a similar argument list (except, 1N/Aof course, that C<$_[2]> will be a reference to the variable). 1N/AThe package name argument will typically be the name of the class into 1N/Awhich the subroutine was declared, but it may also be the name of a derived 1N/Aclass (since handlers are inherited). 1N/AIf a lexical variable is given an attribute, there is no symbol table to 1N/Awhich it belongs, so the symbol table argument (C<$_[1]>) is set to the 1N/Astring C<'LEXICAL'> in that case. Likewise, ascribing an attribute to 1N/Aan anonymous subroutine results in a symbol table argument of C<'ANON'>. 1N/AThe data argument passes in the value (if any) associated with the 1N/Aattribute. For example, if C<&foo> had been declared: 1N/A sub foo :Loud("turn it up to 11, man!") {...} 1N/Athen the string C<"turn it up to 11, man!"> would be passed as the 1N/AAttribute::Handlers makes strenuous efforts to convert 1N/Athe data argument (C<$_[4]>) to a useable form before passing it to 1N/Athe handler (but see L<"Non-interpretive attribute handlers">). 1N/AFor example, all of these: 1N/A sub foo :Loud(till=>ears=>are=>bleeding) {...} 1N/A sub foo :Loud(['till','ears','are','bleeding']) {...} 1N/A sub foo :Loud(qw/till ears are bleeding/) {...} 1N/A sub foo :Loud(qw/my, ears, are, bleeding/) {...} 1N/A sub foo :Loud(till,ears,are,bleeding) {...} 1N/Acauses it to pass C<['till','ears','are','bleeding']> as the handler's 1N/Adata argument. However, if the data can't be parsed as valid Perl, then 1N/Ait is passed as an uninterpreted string. For example: 1N/A sub foo :Loud(my,ears,are,bleeding) {...} 1N/A sub foo :Loud(qw/my ears are bleeding) {...} 1N/Acause the strings C<'my,ears,are,bleeding'> and C<'qw/my ears are bleeding'> 1N/Arespectively to be passed as the data argument. 1N/AIf the attribute has only a single associated scalar data value, that value is 1N/Apassed as a scalar. If multiple values are associated, they are passed as an 1N/Aarray reference. If no value is associated with the attribute, C<undef> is 1N/A=head2 Typed lexicals 1N/ARegardless of the package in which it is declared, if a lexical variable is 1N/Aascribed an attribute, the handler that is invoked is the one belonging to 1N/Athe package to which it is typed. For example, the following declarations: 1N/A my LoudDecl $loudobj : Loud; 1N/A my LoudDecl @loudobjs : Loud; 1N/A my LoudDecl %loudobjex : Loud; 1N/Acauses the LoudDecl::Loud handler to be invoked (even if OtherClass also 1N/Adefines a handler for C<:Loud> attributes). 1N/A=head2 Type-specific attribute handlers 1N/AIf an attribute handler is declared and the C<:ATTR> specifier is 1N/Agiven the name of a built-in type (C<SCALAR>, C<ARRAY>, C<HASH>, or C<CODE>), 1N/Athe handler is only applied to declarations of that type. For example, 1N/Athe following definition: 1N/A sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" } 1N/Acreates an attribute handler that applies only to scalars: 1N/A my $metal : RealLoud; # invokes &LoudDecl::RealLoud 1N/A my @metal : RealLoud; # error: unknown attribute 1N/A my %metal : RealLoud; # error: unknown attribute 1N/A sub metal : RealLoud {...} # error: unknown attribute 1N/AYou can, of course, declare separate handlers for these types as well 1N/A(but you'll need to specify C<no warnings 'redefine'> to do it quietly): 1N/A use Attribute::Handlers; 1N/A no warnings 'redefine'; 1N/A sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" } 1N/A sub RealLoud :ATTR(ARRAY) { print "Urrrrrrrrrr!" } 1N/A sub RealLoud :ATTR(HASH) { print "Arrrrrgggghhhhhh!" } 1N/A sub RealLoud :ATTR(CODE) { croak "Real loud sub torpedoed" } 1N/AYou can also explicitly indicate that a single handler is meant to be 1N/Aused for all types of referents like so: 1N/A use Attribute::Handlers; 1N/A sub SeriousLoud :ATTR(ANY) { warn "Hearing loss imminent" } 1N/A(I.e. C<ATTR(ANY)> is a synonym for C<:ATTR>). 1N/A=head2 Non-interpretive attribute handlers 1N/AOccasionally the strenuous efforts Attribute::Handlers makes to convert 1N/Athe data argument (C<$_[4]>) to a useable form before passing it to 1N/Athe handler get in the way. 1N/AYou can turn off that eagerness-to-help by declaring 1N/Aan attribute handler with the keyword C<RAWDATA>. For example: 1N/A sub Raw : ATTR(RAWDATA) {...} 1N/A sub Nekkid : ATTR(SCALAR,RAWDATA) {...} 1N/A sub Au::Naturale : ATTR(RAWDATA,ANY) {...} 1N/AThen the handler makes absolutely no attempt to interpret the data it 1N/Areceives and simply passes it as a string: 1N/A my $power : Raw(1..100); # handlers receives "1..100" 1N/A=head2 Phase-specific attribute handlers 1N/ABy default, attribute handlers are called at the end of the compilation 1N/Aphase (in a C<CHECK> block). This seems to be optimal in most cases because 1N/Amost things that can be defined are defined by that point but nothing has 1N/AHowever, it is possible to set up attribute handlers that are called at 1N/Aother points in the program's compilation or execution, by explicitly 1N/Astating the phase (or phases) in which you wish the attribute handler to 1N/Abe called. For example: 1N/A sub Early :ATTR(SCALAR,BEGIN) {...} 1N/A sub Normal :ATTR(SCALAR,CHECK) {...} 1N/A sub Late :ATTR(SCALAR,INIT) {...} 1N/A sub Final :ATTR(SCALAR,END) {...} 1N/A sub Bookends :ATTR(SCALAR,BEGIN,END) {...} 1N/AAs the last example indicates, a handler may be set up to be (re)called in 1N/Atwo or more phases. The phase name is passed as the handler's final argument. 1N/ANote that attribute handlers that are scheduled for the C<BEGIN> phase 1N/Aare handled as soon as the attribute is detected (i.e. before any 1N/Asubsequently defined C<BEGIN> blocks are executed). 1N/A=head2 Attributes as C<tie> interfaces 1N/AAttributes make an excellent and intuitive interface through which to tie 1N/Avariables. For example: 1N/A use Attribute::Handlers; 1N/A sub UNIVERSAL::Cycle : ATTR(SCALAR) { 1N/A my ($package, $symbol, $referent, $attr, $data, $phase) = @_; 1N/A $data = [ $data ] unless ref $data eq 'ARRAY'; 1N/A tie $$referent, 'Tie::Cycle', $data; 1N/A my $next : Cycle('A'..'Z'); # $next is now a tied variable 1N/ANote that, because the C<Cycle> attribute receives its arguments in the 1N/AC<$data> variable, if the attribute is given a list of arguments, C<$data> 1N/Awill consist of a single array reference; otherwise, it will consist of the 1N/Asingle argument directly. Since Tie::Cycle requires its cycling values to 1N/Abe passed as an array reference, this means that we need to wrap 1N/Anon-array-reference arguments in an array constructor: 1N/A $data = [ $data ] unless ref $data eq 'ARRAY'; 1N/ATypically, however, things are the other way around: the tieable class expects 1N/Aits arguments as a flattened list, so the attribute looks like: 1N/A sub UNIVERSAL::Cycle : ATTR(SCALAR) { 1N/A my ($package, $symbol, $referent, $attr, $data, $phase) = @_; 1N/A my @data = ref $data eq 'ARRAY' ? @$data : $data; 1N/A tie $$referent, 'Tie::Whatever', @data; 1N/AThis software pattern is so widely applicable that Attribute::Handlers 1N/Aprovides a way to automate it: specifying C<'autotie'> in the 1N/AC<use Attribute::Handlers> statement. So, the cycling example, 1N/Acould also be written: 1N/A use Attribute::Handlers autotie => { Cycle => 'Tie::Cycle' }; 1N/A my $next : Cycle(['A'..'Z']); # $next is now a tied variable 1N/ANote that we now have to pass the cycling values as an array reference, 1N/Asince the C<autotie> mechanism passes C<tie> a list of arguments as a list 1N/A(as in the Tie::Whatever example), I<not> as an array reference (as in 1N/Athe original Tie::Cycle example at the start of this section). 1N/AThe argument after C<'autotie'> is a reference to a hash in which each key is 1N/Athe name of an attribute to be created, and each value is the class to which 1N/Avariables ascribed that attribute should be tied. 1N/ANote that there is no longer any need to import the Tie::Cycle module -- 1N/AAttribute::Handlers takes care of that automagically. You can even pass 1N/Aarguments to the module's C<import> subroutine, by appending them to the 1N/Aclass name. For example: 1N/A use Attribute::Handlers 1N/A autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' }; 1N/AIf the attribute name is unqualified, the attribute is installed in the 1N/Acurrent package. Otherwise it is installed in the qualifier's package: 1N/A use Attribute::Handlers autotie => { 1N/A Other::Good => Tie::SecureHash, # tie attr installed in Other:: 1N/A Bad => Tie::Taxes, # tie attr installed in Here:: 1N/A UNIVERSAL::Ugly => Software::Patent # tie attr installed everywhere 1N/AAutoties are most commonly used in the module to which they actually tie, 1N/Aand need to export their attributes to any module that calls them. To 1N/Afacilitiate this, Attribute::Handlers recognizes a special "pseudo-class" -- 1N/AC<__CALLER__>, which may be specified as the qualifier of an attribute: 1N/A package Tie::Me::Kangaroo:Down::Sport; 1N/A use Attribute::Handlers autotie => { '__CALLER__::Roo' => __PACKAGE__ }; 1N/AThis causes Attribute::Handlers to define the C<Roo> attribute in the package 1N/Athat imports the Tie::Me::Kangaroo:Down::Sport module. 1N/ANote that it is important to quote the __CALLER__::Roo identifier because 1N/Aa bug in perl 5.8 will refuse to parse it and cause an unknown error. 1N/A=head3 Passing the tied object to C<tie> 1N/AOccasionally it is important to pass a reference to the object being tied 1N/Ato the TIESCALAR, TIEHASH, etc. that ties it. 1N/AThe C<autotie> mechanism supports this too. The following code: 1N/A use Attribute::Handlers autotieref => { Selfish => Tie::Selfish }; 1N/A my $var : Selfish(@args); 1N/Ahas the same effect as: 1N/A tie my $var, 'Tie::Selfish', @args; 1N/ABut when C<"autotieref"> is used instead of C<"autotie">: 1N/A use Attribute::Handlers autotieref => { Selfish => Tie::Selfish }; 1N/A my $var : Selfish(@args); 1N/Athe effect is to pass the C<tie> call an extra reference to the variable 1N/A tie my $var, 'Tie::Selfish', \$var, @args; 1N/Amodule, then the following code: 1N/A my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous); 1N/A package SomeOtherClass; 1N/A sub fn :Ugly(sister) :Omni('po',tent()) {...} 1N/Awould cause the following handlers to be invoked: 1N/A # my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous); 1N/A MyClass::Good:ATTR(SCALAR)( 'MyClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A undef # no attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Bad:ATTR(SCALAR)( 'MyClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A 0 # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Omni:ATTR(SCALAR)( 'MyClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A '-vorous' # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/A # sub fn :Ugly(sister) :Omni('po',tent()) {...} 1N/A MyClass::UGLY:ATTR(CODE)( 'SomeOtherClass', # class 1N/A \*SomeOtherClass::fn, # typeglob 1N/A \&SomeOtherClass::fn, # referent 1N/A 'sister' # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Omni:ATTR(CODE)( 'SomeOtherClass', # class 1N/A \*SomeOtherClass::fn, # typeglob 1N/A \&SomeOtherClass::fn, # referent 1N/A ['po','acle'] # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Good:ATTR(ARRAY)( 'SomeOtherClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A undef # no attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Omni:ATTR(ARRAY)( 'SomeOtherClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A "" # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/A MyClass::Good:ATTR(HASH)( 'SomeOtherClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A 'CHECK', # compiler phase 1N/A MyClass::Omni:ATTR(HASH)( 'SomeOtherClass', # class 1N/A 'LEXICAL', # no typeglob 1N/A 'bus' # eval'd attr data 1N/A 'CHECK', # compiler phase 1N/AInstalling handlers into UNIVERSAL, makes them...err..universal. 1N/A package Descriptions; 1N/A use Attribute::Handlers; 1N/A sub name { return $name{$_[2]}||*{$_[1]}{NAME} } 1N/A sub UNIVERSAL::Name :ATTR { 1N/A $name{$_[2]} = $_[4]; 1N/A sub UNIVERSAL::Purpose :ATTR { 1N/A print STDERR "Purpose of ", &name, " is $_[4]\n"; 1N/A sub UNIVERSAL::Unit :ATTR { 1N/A print STDERR &name, " measured in $_[4]\n"; 1N/A my $capacity : Name(capacity) 1N/A : Purpose(to store max storage capacity for files) 1N/A sub foo : Purpose(to foo all data before barring it) { } 1N/A=item C<Bad attribute type: ATTR(%s)> 1N/AAn attribute handler was specified with an C<:ATTR(I<ref_type>)>, but the 1N/Atype of referent it was defined to handle wasn't one of the five permitted: 1N/AC<SCALAR>, C<ARRAY>, C<HASH>, C<CODE>, or C<ANY>. 1N/A=item C<Attribute handler %s doesn't handle %s attributes> 1N/AA handler for attributes of the specified name I<was> defined, but not 1N/Afor the specified type of declaration. Typically encountered whe trying 1N/Ato apply a C<VAR> attribute handler to a subroutine, or a C<SCALAR> 1N/Aattribute handler to some other type of variable. 1N/A=item C<Declaration of %s attribute in package %s may clash with future reserved word> 1N/AA handler for an attributes with an all-lowercase name was declared. An 1N/Aattribute with an all-lowercase name might have a meaning to Perl 1N/Aitself some day, even though most don't yet. Use a mixed-case attribute 1N/A=item C<Can't have two ATTR specifiers on one subroutine> 1N/AYou just can't, okay? 1N/AInstead, put all the specifications together with commas between them 1N/Ain a single C<ATTR(I<specification>)>. 1N/A=item C<Can't autotie a %s> 1N/AYou can only declare autoties for types C<"SCALAR">, C<"ARRAY">, and 1N/AC<"HASH">. They're the only things (apart from typeglobs -- which are 1N/Anot declarable) that Perl can tie. 1N/A=item C<Internal error: %s symbol went missing> 1N/ASomething is rotten in the state of the program. An attributed 1N/Asubroutine ceased to exist between the point it was declared and the point 1N/Aat which its attribute handler(s) would have been called. 1N/A=item C<Won't be able to apply END handler> 1N/AYou have defined an END handler for an attribute that is being applied 1N/Ato a lexical variable. Since the variable may not be available during END 1N/ADamian Conway (damian@conway.org) 1N/AThere are undoubtedly serious bugs lurking somewhere in code this funky :-) 1N/ABug reports and other feedback are most welcome. 1N/A Copyright (c) 2001, Damian Conway. All Rights Reserved. 1N/A This module is free software. It may be used, redistributed 1N/A and/or modified under the same terms as Perl itself.