File Coverage

blib/lib/Regexp/DeferredExecution.pm

Criterion	Covered	Total	%
statement	18	25	72.0
branch	1	4	25.0
condition			n/a
subroutine	7	7	100.0
pod	0	1	0.0
total	26	37	70.2

package Regexp::DeferredExecution;

use strict;
use vars qw($VERSION);

$VERSION = '0.05';

use Text::Balanced qw( extract_multiple
		       extract_codeblock
		     );

use overload;

sub import {
    shift;
    overload::constant('qr' => \&convert);
}

sub unimport {
    shift;
    overload::remove_constant('qr');
}

sub convert {

    my $re = shift;

    return $re unless $re =~ m/\(\?\{/; # no need to alter this one.

    my @chunks =
	extract_multiple($re,
			 [ qr/\(\?   # '(?' (escaped)
			      (?=\{) # followed by '{' (lookahead)
			     /x,
			   \&extract_codeblock
			 ]
			);

    for (my $i = 1 ; $i < @chunks ; $i++) {
	# wrap all code into a closure and push onto the stack:
	if ($chunks[$i-1] eq "(?") {
	    $chunks[$i] =~ s/\A \{
                             (.*)
                             \} \Z
                            /{
  local \@Regexp::DeferredExecution::c = \@Regexp::DeferredExecution::c;
  push \@Regexp::DeferredExecution::c, [\$^N, q{$1}];
}/msx;
	}
    }

    $re = join("", @chunks);

    # install the stack storage and execution code:
    $re = "(?{
  local \@Regexp::DeferredExecution::c = ();
})$re(?{
  for (\@Regexp::DeferredExecution::c) {
    \$^N = \$\$_[0];
    eval \$\$_[1];
  }
})";

    return $re;
}

1;
__END__