File Coverage

blib/lib/Language/P/Toy/Value/Regex.pm

Criterion	Covered	Total	%
statement	34	37	91.8
branch	2	2	100.0
condition			n/a
subroutine	6	8	75.0
pod	0	2	0.0
total	42	49	85.7

package Language::P::Toy::Value::Regex;

use strict;
use warnings;
use base qw(Language::P::Toy::Value::Code);

use Language::P::ParseTree qw(:all);

use constant
  { REGEXP_NO_MORE_MATCHES => -1,
    REGEXP_SCAN_ALL        => -2,
    };

sub next_start {
    my( $self, $start ) = @_;

    return REGEXP_SCAN_ALL;
}

sub match {
    my( $self, $runtime, $string ) = @_;

    # print "String: $string\n";

    my $rv;
    # make space for the values
    push @{$runtime->{_stack}}, 0, $string;
    foreach my $i ( 0 .. length( $string ) ) {
        local $SIG{__WARN__} = sub { Carp::confess @_ };
        $runtime->{_stack}[-2] = $i;
        # print "Start: $i\n";
        $self->call( $runtime, -2, CXT_VOID ); # -2 so we can blindly add 1
        $runtime->run;
        $rv = pop @{$runtime->{_stack}};

        next unless $rv->{matched};

        $rv->{match_start} = $i;
        # print 'Matched: "' . substr( $string, $i, $rv->{match_end} - $i )
        #                    . "\"\n";
        last;
    }
    # clean stack
    pop @{$runtime->{_stack}};
    pop @{$runtime->{_stack}};

#     if( !$rv->{matched} ) {
#         print "No match\n";
#     }

    return $rv;
}

1;