package Attribute::Handlers;
use 5.006;
use Carp;
use warnings;
$VERSION = '0.78_02';
# $DB::single=1;

my %symcache;
sub findsym {
	my ($pkg, $ref, $type) = @_;
	return $symcache{$pkg,$ref} if $symcache{$pkg,$ref};
	$type ||= ref($ref);
	my $found;
        foreach my $sym ( values %{$pkg."::"} ) {
            return $symcache{$pkg,$ref} = \$sym
		if *{$sym}{$type} && *{$sym}{$type} == $ref;
	}
}

my %validtype = (
	VAR	=> [qw[SCALAR ARRAY HASH]],
        ANY	=> [qw[SCALAR ARRAY HASH CODE]],
        ""	=> [qw[SCALAR ARRAY HASH CODE]],
        SCALAR	=> [qw[SCALAR]],
        ARRAY	=> [qw[ARRAY]],
        HASH	=> [qw[HASH]],
        CODE	=> [qw[CODE]],
);
my %lastattr;
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,...}";
}

my $qual_id = qr/^[_a-z]\w*(::[_a-z]\w*)*$/i;

sub import {
    my $class = shift @_;
    return unless $class eq "Attribute::Handlers";
    while (@_) {
	my $cmd = shift;
        if ($cmd =~ /^autotie((?:ref)?)$/) {
	    my $tiedata = ($1 ? '$ref, ' : '') . '@$data';
            my $mapping = shift;
	    _usage_AH_ $class unless ref($mapping) eq 'HASH';
	    while (my($attr, $tieclass) = each %$mapping) {
                $tieclass =~ s/^([_a-z]\w*(::[_a-z]\w*)*)(.*)/$1/is;
		my $args = $3||'()';
		_usage_AH_ $class unless $attr =~ $qual_id
		                 && $tieclass =~ $qual_id
		                 && eval "use base $tieclass; 1";
	        if ($tieclass->isa('Exporter')) {
		    local $Exporter::ExportLevel = 2;
		    $tieclass->import(eval $args);
	        }
		$attr =~ s/__CALLER__/caller(1)/e;
		$attr = caller()."::".$attr unless $attr =~ /::/;
	        eval qq{
	            sub $attr : ATTR(VAR) {
			my (\$ref, \$data) = \@_[2,4];
			my \$was_arrayref = ref \$data eq 'ARRAY';
			\$data = [ \$data ] unless \$was_arrayref;
			my \$type = ref(\$ref)||"value (".(\$ref||"<undef>").")";
			 (\$type eq 'SCALAR')? tie \$\$ref,'$tieclass',$tiedata
			:(\$type eq 'ARRAY') ? tie \@\$ref,'$tieclass',$tiedata
			:(\$type eq 'HASH')  ? tie \%\$ref,'$tieclass',$tiedata
			: die "Can't autotie a \$type\n"
	            } 1
	        } or die "Internal error: $@";
	    }
        }
        else {
            croak "Can't understand $_"; 
        }
    }
}
sub _resolve_lastattr {
	return unless $lastattr{ref};
	my $sym = findsym @lastattr{'pkg','ref'}
		or die "Internal error: $lastattr{pkg} symbol went missing";
	my $name = *{$sym}{NAME};
	warn "Declaration of $name attribute in package $lastattr{pkg} may clash with future reserved word\n"
		if $^W and $name !~ /[A-Z]/;
	foreach ( @{$validtype{$lastattr{type}}} ) {
		*{"$lastattr{pkg}::_ATTR_${_}_${name}"} = $lastattr{ref};
	}
	%lastattr = ();
}