[perl #22236] File::Basename behavior is misleading

[perl5.git] / lib / Attribute / Handlers.pm

diff --git a/lib/Attribute/Handlers.pm b/lib/Attribute/Handlers.pm
index 59c0934..74c1c79 100644 (file)
--- a/lib/Attribute/Handlers.pm
+++ b/lib/Attribute/Handlers.pm
@@ -2,7 +2,7 @@ package Attribute::Handlers;
 use 5.006;
 use Carp;
 use warnings;
-$VERSION = '0.76';
+$VERSION = '0.78_01';
 # $DB::single=1;
 
 my %symcache;
@@ -31,6 +31,14 @@ my @declarations;
 my %raw;
 my %phase;
 my %sigil = (SCALAR=>'$', ARRAY=>'@', HASH=>'%');
+my $global_phase = 0;
+my %global_phases = (
+       BEGIN   => 0,
+       CHECK   => 1,
+       INIT    => 2,
+       END     => 3,
+);
+my @global_phases = qw(BEGIN CHECK INIT END);
 
 sub _usage_AH_ {
        croak "Usage: use $_[0] autotie => {AttrName => TieClassName,...}";
@@ -95,12 +103,12 @@ sub AUTOLOAD {
        my ($class) = $AUTOLOAD =~ m/(.*)::/g;
        $AUTOLOAD =~ m/_ATTR_(.*?)_(.*)/ or
            croak "Can't locate class method '$AUTOLOAD' via package '$class'";
-       croak "Attribute handler '$3' doesn't handle $2 attributes";
+       croak "Attribute handler '$2' doesn't handle $1 attributes";
 }
 
 sub DESTROY {}
 
-my $builtin = qr/lvalue|method|locked/;
+my $builtin = qr/lvalue|method|locked|unique|shared/;
 
 sub _gen_handler_AH_() {
        return sub {
@@ -120,6 +128,8 @@ sub _gen_handler_AH_() {
                        $phase{$ref}{CHECK} = 1
                                if $data =~ s/\s*,?\s*(CHECK)\s*,?\s*//
                                || ! keys %{$phase{$ref}};
+                       # Added for cleanup to not pollute next call.
+                       (%lastattr = ()),
                        croak "Can't have two ATTR specifiers on one subroutine"
                                if keys %lastattr;
                        croak "Bad attribute type: ATTR($data)"
@@ -127,12 +137,27 @@ sub _gen_handler_AH_() {
                        %lastattr=(pkg=>$pkg,ref=>$ref,type=>$data);
                }
                else {
-                       my $handler = $pkg->can($attr);
+                       my $type = ref $ref;
+                       my $handler = $pkg->can("_ATTR_${type}_${attr}");
                        next unless $handler;
                        my $decl = [$pkg, $ref, $attr, $data,
                                    $raw{$handler}, $phase{$handler}];
-                       _apply_handler_AH_($decl,'BEGIN');
-                       push @declarations, $decl;
+                       foreach my $gphase (@global_phases) {
+                           _apply_handler_AH_($decl,$gphase)
+                               if $global_phases{$gphase} <= $global_phase;
+                       }
+                       if ($global_phase != 0) {
+                               # if _gen_handler_AH_ is being called after 
+                               # CHECK it's for a lexical, so make sure
+                               # it didn't want to run anything later
+                       
+                               local $Carp::CarpLevel = 2;
+                               carp "Won't be able to apply END handler"
+                                       if $phase{$handler}{END};
+                       }
+                       else {
+                               push @declarations, $decl
+                       }
                }
                $_ = undef;
            }
@@ -140,9 +165,10 @@ sub _gen_handler_AH_() {
        }
 }
 
-*{"MODIFY_${_}_ATTRIBUTES"} = _gen_handler_AH_ foreach @{$validtype{ANY}};
-push @UNIVERSAL::ISA, 'Attribute::Handlers'
-       unless grep /^Attribute::Handlers$/, @UNIVERSAL::ISA;
+*{"Attribute::Handlers::UNIVERSAL::MODIFY_${_}_ATTRIBUTES"} =
+       _gen_handler_AH_ foreach @{$validtype{ANY}};
+push @UNIVERSAL::ISA, 'Attribute::Handlers::UNIVERSAL'
+       unless grep /^Attribute::Handlers::UNIVERSAL$/, @UNIVERSAL::ISA;
 
 sub _apply_handler_AH_ {
        my ($declaration, $phase) = @_;
@@ -168,14 +194,21 @@ sub _apply_handler_AH_ {
        return 1;
 }
 
-CHECK {
-       _resolve_lastattr;
-       _apply_handler_AH_($_,'CHECK') foreach @declarations;
-}
+{
+        no warnings 'void';
+        CHECK {
+               $global_phase++;
+               _resolve_lastattr;
+               _apply_handler_AH_($_,'CHECK') foreach @declarations;
+        }
 
-INIT { _apply_handler_AH_($_,'INIT') foreach @declarations }
+        INIT {
+                $global_phase++;
+                _apply_handler_AH_($_,'INIT') foreach @declarations
+        }
+}
 
-END { _apply_handler_AH_($_,'END') foreach @declarations }
+END { $global_phase++; _apply_handler_AH_($_,'END') foreach @declarations }
 
 1;
 __END__
@@ -186,8 +219,8 @@ Attribute::Handlers - Simpler definition of attribute handlers
 
 =head1 VERSION
 
-This document describes version 0.76 of Attribute::Handlers,
-released November 15, 2001.
+This document describes version 0.78 of Attribute::Handlers,
+released October 5, 2002.
 
 =head1 SYNOPSIS
 
@@ -571,11 +604,14 @@ C<__CALLER__>, which may be specified as the qualifier of an attribute:
 
         package Tie::Me::Kangaroo:Down::Sport;
 
-        use Attribute::Handlers autotie => { __CALLER__::Roo => __PACKAGE__ };
+        use Attribute::Handlers autotie => { '__CALLER__::Roo' => __PACKAGE__ };
 
 This causes Attribute::Handlers to define the C<Roo> attribute in the package
 that imports the Tie::Me::Kangaroo:Down::Sport module.
 
+Note that it is important to quote the __CALLER__::Roo identifier because
+a bug in perl 5.8 will refuse to parse it and cause an unknown error.
+
 =head3 Passing the tied object to C<tie>
 
 Occasionally it is important to pass a reference to the object being tied
@@ -787,6 +823,12 @@ Something is rotten in the state of the program. An attributed
 subroutine ceased to exist between the point it was declared and the point
 at which its attribute handler(s) would have been called.
 
+=item C<Won't be able to apply END handler>
+
+You have defined an END handler for an attribute that is being applied
+to a lexical variable.  Since the variable may not be available during END
+this won't happen.
+
 =back
 
 =head1 AUTHOR