File Coverage

blib/lib/String/Interpolate/Delayed.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

use 5.008;
use strict;
use warnings;

package String::Interpolate::Delayed;

our $AUTHORITY = "cpan:TOBYINK";
our $VERSION   = "0.001";

our $WORKAROUND = 1;

use overload q[""] => "interpolated", fallback => 1;

use PadWalker ();
use PerlX::QuoteOperator ();
use String::Interpolate ();
use UNIVERSAL::ref;

sub import
{
	my $class = shift;
	my ($name) = @_;

	my $code = sub ($) {
		my $text = shift;
		bless \$text;
	};

	"PerlX::QuoteOperator"->new->import(
		$name || "delayed",
		{ -emulate => 'q', -with => $code },
		scalar caller,
	);
}

sub new
{
	my $class = shift;
	my ($text) = @_;

	bless \$text => $class;
}

sub uninterpolated
{
	my $self = shift;

	return $$self;
}

sub _clean
{
	my ($refs) = @_;
	+{ map {; substr($_, 1) => $refs->{$_} } keys %$refs };
}

sub interpolated
{
	my $self = shift;

	my $stri = "String::Interpolate"->new;

	if ($WORKAROUND) {
		# Workaround for bug in the ->pragma() accessor...
		$$stri->{pragmas} = 'import strict "vars";';
	}
	else {
		$$stri->pragma('import strict "vars";');
	}

	$stri->exec(
		_clean(PadWalker::peek_our 1),
		_clean(PadWalker::peek_my 1),
		grep(ref($_) eq 'HASH', @_),
	);
	return $stri->exec($$self);
}

sub ref
{
	return undef;
}

1 && __PACKAGE__
__END__