File Coverage

blib/lib/autobox/Closure/Attributes.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package autobox::Closure::Attributes;
use strict;
use warnings;
use base 'autobox';
use B;
use Want;
our $VERSION = '0.05_1';

our @leaves;

sub import {
    shift->SUPER::import(CODE => 'autobox::Closure::Attributes::Methods');
    push @leaves, $^H{autobox_leave}; # keep them forever so their destructor never gets invoked?
}

package autobox::Closure::Attributes::Methods;
use PadWalker;

sub AUTOLOAD :lvalue {
    my $code = shift;
    (my $method = our $AUTOLOAD) =~ s/.*:://;
    return if $method eq 'DESTROY';

    # we want the scalar unless the method name already a sigil
    my $attr = $method  =~ /^[\$\@\%\&\*]/ ? $method : '$' . $method;

    my $closed_over = PadWalker::closed_over($code);

    # is there a method of that name in the package the coderef was created in?
    # if so, run it.
    # give methods priority over the variables we close over.
    # XXX this isn't lvalue friendly, but sdw can't figure out how to make it be and not piss off old perls.

    my $stash = B::svref_2object($code)->STASH->NAME;
    if( $stash and $stash->can($method) ) {
        return $stash->can($method)->( $code, @_ );
    }

    exists $closed_over->{$attr} or Carp::croak "$code does not close over $attr";

    my $ref = ref $closed_over->{$attr};

    if (@_) {
        return @{ $closed_over->{$attr} } = @_ if $ref eq 'ARRAY';
        return %{ $closed_over->{$attr} } = @_ if $ref eq 'HASH';
        return ${ $closed_over->{$attr} } = shift;
    }

    $ref eq 'HASH' || $ref eq 'ARRAY' ? $closed_over->{$attr} : ${ $closed_over->{$attr} };  # lvalue friendly return

}

1;

__END__