File Coverage

blib/lib/Acme/Lexical/Thief.pm

Criterion	Covered	Total	%
statement	48	49	97.9
branch	9	12	75.0
condition	1	2	50.0
subroutine	12	13	92.3
pod			n/a
total	70	76	92.1

package Acme::Lexical::Thief;

use 5.012;
use strict;
use warnings;
no warnings qw( once void uninitialized numeric );

BEGIN {
	$Acme::Lexical::Thief::AUTHORITY = 'cpan:TOBYINK';
	$Acme::Lexical::Thief::VERSION   = '0.001';
}

use Carp;
use Keyword::Simple ();
use PadWalker ();
use Text::Balanced ();

my $KEYWORD = 'steal';
my $CLASS   = __PACKAGE__;

sub import
{
	Keyword::Simple::define $KEYWORD, sub
	{
		my $ref = shift;
		$$ref =~ s/^\s+//;

		my $depth = 0;
		if ($$ref =~ /^((?: 0x[0-9A-F]+ | 0b[0-1]+ | 0[0-7]* | [1-9][0-9]* )\s*)/ixs)
		{
			$depth = eval $1;
			substr($$ref, 0, length $1) = '';
		}

		my $extracted;
		if ($$ref =~ /^\(/)
		{
			$extracted = Text::Balanced::extract_bracketed($$ref)
				or croak "usage: $KEYWORD (VARIABLES);";
			$extracted =~ s/(^\(|\)$)//gs;
		}
		else
		{
			($extracted, $$ref) = ($$ref =~ /^([^;]+)(;.*)$/s)
				or croak "usage: $KEYWORD VARIABLES;";
		}
		(my $globs = $extracted) =~ s/[\$\%\@]/*/gs;
		$$ref = "our($extracted); local($globs) = $CLASS\::_callback(q($extracted), $depth);$$ref";
	}
}

sub unimport
{
	Keyword::Simple::undefine $KEYWORD;
}

sub _callback
{
	my $vars  = shift;
	my $depth = shift // 0;

	$vars =~ s/(^\s*|\s*$)//g;
	my @vars = split /\s*,\s*/, $vars;

	my $MY  = PadWalker::peek_my($depth + 2);
	my $OUR = PadWalker::peek_our($depth + 2);
	return map {
		exists $MY->{$_}  ? $MY->{$_} :
		exists $OUR->{$_} ? $OUR->{$_} :
		croak "$KEYWORD($_) failed; caller has no $_ defined";
	} @vars;
}

1;

__END__