File Coverage

lib/Sub/Quotelike.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

package Sub::Quotelike;

use strict;
use warnings;
use Filter::Simple;
use Text::Balanced qw/extract_quotelike/;

our $VERSION = 0.03;
our %qq_subs = ();

FILTER {
    while (s/(\bsub\s+(\w+)\s*)\((["'])\3?\)/$1(\$)/) {
	if (exists $qq_subs{$2} && $qq_subs{$2} ne $3) {
	    die "Prototype mismatch: $2 ($3) vs $2 ($qq_subs{$2})";
	}
	$qq_subs{$2} = $3;
    }
    for my $s (keys %qq_subs) {
	my $qq = $qq_subs{$s} eq q(") ? 'qq' : 'q';
	s/\bsub\s+$s\b/sub __qUoTeLiKe_$s/g;
	s/{\s*(["']?)$s\1\s*}/{__qUoTeLiKe_$s}/g;
	s/(?)/__qUoTeLiKe_$s($qq/g;
	while (/__qUoTeLiKe_$s\((?=q)/g) {
	    my $savepos = pos;
	    () = extract_quotelike($_);
	    s/\G/)/;
	    pos() = $savepos;
	}
    }
    s/__qUoTeLiKe_//g;
};

1;

__END__