Re: Checking whether a string is a prefix of any string matching a given regular expression

I don't think that you can expect the regex engine to help much here.

If your regex always match fixed length strings, which is fairly typical for this kind field entry data validation application, then you might get away with padding the partial string from a known good pattern something like this:

#! perl -slw
use strict;

my $re = qr[^\d{3}-\d{3}$];
my $pat = '111-111';

my @inputs = (
    '',
    'a',
    '1',
    '12',
    '12x',
    '123',
    '1234',
    '123-',
    '123x',
    '123-4',
    '123-x',
    '123-456',
    '123-4567'
);

for my $input ( @inputs ) {
    print "$input failed" and next if length $input > length $pat;
    my $test = $input . substr( $pat, length( $input ) );
    print $input, $test =~ $re ? ' passed' : ' failed';
}

__END__
P:\test>471541
 passed
a failed
1 passed
12 passed
12x failed
123 passed
1234 failed
123- passed
123x failed
123-4 passed
123-x failed
123-456 passed
123-4567 failed
[download]

Otherwise, if your patterns can contain variable width quantifiers, but not unbounded quantifiers (eg. .? or .{1,3} would okay but .*, .+ and .{3,} would not be), then it would not be too hard to programmically break up simple regex into a set of equivalent regex that could be applied sequentially or as an alternation to do the vaidation. I say not too hard, but non-trivial enough that you would need to apply a set of restrictions on what patterns where acceptable in the original regex. In other words, non-trivial enough that I wasn't prepared to expend the effort trying to do it for the purposes of demonstaration :). Hence, I hand coded the break up for your sample regex in the code below.

#! perl -slw
use strict;

my @re = (
    '^$',
    '^\d{0,3}$',
    '^\d{3}-$',
    '^\d{3}-\d{0,3}$',
    '^\d{3}-\d{3}$',
);

my $re = join '|', reverse @re;

$re =  qr[$re];

my @inputs = (
    '',
    'a',
    '1',
    '12',
    '12x',
    '123',
    '1234',
    '123-',
    '123x',
    '123-4',
    '123-x',
    '123-456',
    '123-4567'
);

for my $input ( @inputs ) {
    print $input, $input =~ $re ? ' passed ' : ' failed ', 'the altern
+ation';
    
    for my $reg ( @re ) {
        if( $input =~ $reg ) {
            print "$input passed";
            last;
        } else {
            print "$input failed";
        }
    }
}

__END__
P:\test>471541-2
 passed the alternation
 passed
a failed the alternation
a failed
a failed
a failed
a failed
a failed
1 passed the alternation
1 failed
1 passed
12 passed the alternation
12 failed
12 passed
12x failed the alternation
12x failed
12x failed
12x failed
12x failed
12x failed
123 passed the alternation
123 failed
123 passed
1234 failed the alternation
1234 failed
1234 failed
1234 failed
1234 failed
1234 failed
123- passed the alternation
123- failed
123- failed
123- passed
123x failed the alternation
123x failed
123x failed
123x failed
123x failed
123x failed
123-4 passed the alternation
123-4 failed
123-4 failed
123-4 failed
123-4 passed
123-x failed the alternation
123-x failed
123-x failed
123-x failed
123-x failed
123-x failed
123-456 passed the alternation
123-456 failed
123-456 failed
123-456 failed
123-456 passed
123-4567 failed the alternation
123-4567 failed
123-4567 failed
123-4567 failed
123-4567 failed
123-4567 failed
[download]

Better code would require a better spec.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?

"Science is about questioning the status quo. Questioning authority".

The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.

Comment on Re: Checking whether a string is a prefix of any string matching a given regular expression Select or Download Code