in reply to Check a string for consecutive digits

You could use match-time pattern interpolation.

$ perl -Mstrict -Mwarnings -E '
say m{(?x) ( \d ) (??{ ( $1 + 1 ) . ( $1 + 2 ) . ( $1 + 3 ) }) }
   ? qq{$_ - Match}
   : qq{$_ - No match}
   for qw{ abc ab12c 2345 234y 01234 };'
abc - No match
ab12c - No match
2345 - Match
234y - No match
01234 - Match
$

[download]

I hope this is helpful.

Cheers,

JohnGG

Replies are listed 'Best First'.
Re^2: Check a string for consecutive digits
by Anonymous Monk on Nov 25, 2015 at 23:58 UTC

    Thanks for that, it looked like complete gibberish 20 minutes ago but after some searching I have a handle on most of it now.

    I've reduced it down to this:

    exit 1 if $password =~ /(?x) ( \d ) (??{ ( $1 + 1 ) . ( $1 + 2 ) . ( $1 + 3 ) })/

    Can this be easily adapted to allow an arbitrary number of consecutive digits? In my current code, the limit is configurable.

[reply]

      Sorry for the slow reply, $work rather got in the way. Yes, it can be adapted quite easily:-

      use strict;
use warnings;

use 5.014;
use re qw{ eval };

my $max = shift || 3;

my $ascPatt  =
   q{(?x) ( \d ) (??{ join q{}, map { $1 + $_ } 1 .. $max }) };
my $descPatt =
   q{(?x) ( \d ) (??{ join q{}, map { $1 - $_ } 1 .. $max }) };

my @passwords = qw{
   1234 1243 4321 298761 4562 4568 4578 123 12 1
   01234 01243 04321 0298761 04562 04568 04578 0123 012 01
   a1234 1a234 12a34 123a4 1234a
   a1b2c3 a12b34c56 a1b2c3d a12b34c56d
   a123b45c6 a12b345c6 a123b45c6d a12b345c6d
   1a2 1ab2 12ab34 12abc34def 12abc34def567
   abc ab12c 2345 234y 01234 2356
   };

say
   qq{$_ - },
   checkConsec( $_ )
   ? q{too many consecutive digits}
   : q{pass}
   for @passwords;


sub checkConsec
{
    my $pw = shift;
    return 1 if $pw =~ m{$ascPatt};
    return 1 if $pw =~ m{$descPatt};
    return 0;
}

      [download]

      Three runs, the first using the default of no more than three consecutive digits, then four and two.

      Read more... (3 kB)

      I hope this is helpful.

      Cheers,

      JohnGG

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom