File Coverage

blib/lib/PerlX/QuoteOperator/Inescapable.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	6	8	75.0
condition	4	5	80.0
subroutine	16	17	94.1
pod			n/a
total	86	91	94.5

package PerlX::QuoteOperator::Inescapable;

use 5.010001;
use strict;
use warnings;
no warnings qw( void once uninitialized );

BEGIN {
	$PerlX::QuoteOperator::Inescapable::AUTHORITY = 'cpan:TOBYINK';
	$PerlX::QuoteOperator::Inescapable::VERSION   = '0.002';
}

use Carp qw/croak/;
use Devel::Declare;
use Data::OptList;
use Sub::Install qw/install_sub/;

use parent qw/Devel::Declare::Context::Simple/;

sub import
{
	my $caller = caller;
	my $self   = shift;

	@_ = 'Q' unless @_;
	my $optlist = Data::OptList::mkopt(\@_);

	for my $opt ( @$optlist )
	{
		my ($declarator, $callback) = @$opt;
		$callback //= sub ($) { +shift };
		$callback = delete $callback->{'-with'} if ref $callback eq 'HASH';

		$self = $self->new unless ref $self;
		Devel::Declare->setup_for(
			$caller,
			{ $declarator => { const => sub { $self->_parser(@_) } } }
		);

		install_sub {
			into    => $caller,
			as      => $declarator,
			code    => $callback,
		};
	}
}

sub unimport
{
	$^H{(__PACKAGE__)} = undef;
}

sub _parser
{
	my $self = shift;
	$self->init(@_);

	$self->skip_declarator;
	$self->skipspace;

	my $linestr = $self->get_linestr;

	my $remaining = substr($linestr, $self->offset);
	my $starter   = substr($remaining, 0, 1);
	my $ender     = $self->_ender($starter);

	my $ending    = index($remaining, $ender, 1);
	croak "Unterminated inescapable quoted string found: '$remaining'" if $ending < 0;

	substr($remaining, 0, $ending+1) = sprintf("('%s')", $self->_quote(substr $remaining, 1, $ending-1));
	substr($linestr, $self->offset)  = $remaining;

	$self->set_linestr($linestr);
}

sub _ender
{
	my ($self, $str) = @_;
	{
		'('    => ')',
		'{'    => '}',
		'['    => ']',
		'<'    => '>',
	}->{$str} // $str;
}

sub _quote
{
	my ($self, $str) = @_;
	$str =~ s{([\\\'])}{\\$1}g;
	return $str;
}

__FILE__
__END__