File Coverage

blib/lib/Lexical/Context.pm

Criterion	Covered	Total	%
statement	35	38	92.1
branch	6	10	60.0
condition	2	3	66.6
subroutine	7	7	100.0
pod	0	2	0.0
total	50	60	83.3

package Lexical::Context;

use strictures 2;
use B qw(svref_2object);
use Moo;

has code => (is => 'ro', required => 1);

has _pad_indices => (is => 'lazy', builder => sub {
  my ($self) = @_;
  my @b_pn = svref_2object($self->code)->PADLIST->ARRAYelt(0)->ARRAY;
  return +{
    map +($b_pn[$_]->PV => $_),
      grep {
        my $b_pn = $b_pn[$_];
        $b_pn->can('PV') and do {
          my $pn = $b_pn->PV;
          defined($pn) and length($pn) and $pn ne '&'
        };
      } 0..$#b_pn
  };
});

sub _current_pad {
  my ($self) = @_;
  return (svref_2object($self->code)->PADLIST->ARRAY)[-1]->ARRAY;
}

sub get_pad_values {
  my ($self) = @_;
  my $pad_indices = $self->_pad_indices;
  my @curpad = $self->_current_pad;
  return +{
    map +($_ => $curpad[$pad_indices->{$_}]->object_2svref),
      keys %$pad_indices
  };
}

sub set_pad_values {
  my ($self, $new_values) = @_;
  my $pad_indices = $self->_pad_indices;
  my @curpad = $self->_current_pad;
  foreach my $name (keys %$new_values) {
    my $pad_value = $curpad[$pad_indices->{$name}]->object_2svref;
    if ($name =~ /^\$/) {
      ${$pad_value} = ${$new_values->{$name}};
    } elsif ($name =~ /^\@/) {
      @{$pad_value} = @{$new_values->{$name}};
    } elsif ($name =~ /^\%/) {
      %{$pad_value} = %{$new_values->{$name}};
    }
  }
  return;
}

1;