view release on metacpan or  search on metacpan

lib/Attribute/Handlers.pm  view on Meta::CPAN

				# 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;
	    }
	    return grep {defined && !/$builtin/} @attrs;
	}
}

{
    no strict 'refs';
    *{"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) = @_;
	my ($pkg, $ref, $attr, $data, $raw, $handlerphase, $filename, $linenum) = @$declaration;
	return unless $handlerphase->{$phase};
        print STDERR "Handling $attr on $ref in $phase with [$data]\n"
            if $debug;
	my $type = ref $ref;
	my $handler = "_ATTR_${type}_${attr}";
	my $sym = findsym($pkg, $ref);
	$sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL';
	no warnings;
	if (!$raw && defined($data)) {
	    if ($data ne '') {
                # keeping the minimum amount of code inside the eval string
                # makes debugging perl internals issues with this logic easier.
                my $code= "package $pkg; my \$ref= [$data]; \$data= \$ref; 1";
                print STDERR "Evaling: '$code'\n"
                    if $debug;
                local $SIG{__WARN__} = sub{ die };
                no strict;
                no warnings;
                # Note in production we do not need to use the return value from
                # the eval or even consult $@ after the eval - if the evaled code
                # compiles and runs successfully then it will update $data with
                # the compiled form, if it fails then $data stays unchanged. The
                # return value and $@ are only used for debugging purposes.
                # IOW we could just replace the following with eval($code);
                eval($code) or do {
                    print STDERR "Eval failed: $@"
                        if $debug;
                };
	    }
	    else { $data = undef }
	}

        # now call the handler with the $data decoded (maybe)
	$pkg->$handler($sym,
		       (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
		       $attr,
		       $data,
		       $phase,
		       $filename,
		       $linenum,
		      );
	return 1;
}

{
        no warnings 'void';
        CHECK {
                $global_phase++;
                _resolve_lastattr if _delayed_name_resolution;
                foreach my $decl (@declarations) {
                        _apply_handler_AH_($decl, 'CHECK');
                }
        }

        INIT {
                $global_phase++;
                foreach my $decl (@declarations) {
                        _apply_handler_AH_($decl, 'INIT');
                }
        }
}

END {
        $global_phase++;
        foreach my $decl (@declarations) {
                _apply_handler_AH_($decl, 'END');
        }
}

1;
__END__

=head1 NAME

Attribute::Handlers - Simpler definition of attribute handlers

=head1 VERSION

This document describes version 1.03 of Attribute::Handlers.

=head1 SYNOPSIS

    package MyClass;
    require 5.006;
    use Attribute::Handlers;
    no warnings 'redefine';


    sub Good : ATTR(SCALAR) {
	my ($package, $symbol, $referent, $attr, $data) = @_;

	# Invoked for any scalar variable with a :Good attribute,
	# provided the variable was declared in MyClass (or