Attribute-Handlers-Clean

 view release on metacpan or  search on metacpan

demo/Demo.pm  view on Meta::CPAN

sub Demo : ATTR(SCALAR) {
	my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR 'Scalar $', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr}\n",
		     "with data ($data)\nin phase $phase\n";
};

sub This : ATTR(SCALAR) {
	print STDERR "This at ",
		     join(":", map { defined() ? $_ : "" } caller(1)),
		     "\n";
}

sub Demo : ATTR(HASH) {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR 'Hash %', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr} with data ($data)\n";
};

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

            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 q\0$tieclass\0; 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 '# line '.__LINE__.' "'.__FILE__.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 :



( run in 0.365 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )