Password Regex extended

[3dbc]

Hello perlmonks, I'm trying to extend this regex to match 3 of 4 submatches.

^.*(?=.{10,})(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[@#$%^&+=]).*$

Not 4 of 4 like it's currently doing.
Update 3:
$1 is a requirement, I.E. $2, $3, $4, $5 - if any three {3,4} or more match then it's a match.

Update: I enjoy perl, but also enjoy perlre and If possible would prefer a regex centric solution. I.E. is there a way to due this with one line of regex or do we need perl to do the 3 of 4 logic?

Update 2: Here's a description of what the current regex should do:
* Must be at least 10 characters
* Must contain at least one one lower case letter, one upper case letter, one digit and one special character (this should be 3 or more...)
* Valid special characters are - @#$%^&+=
All advice is appreciated. Thanks,

[ikegami]

I'm trying to extend this regex to match 3 of 4 submatches.

First, you have 5 submatches, not 4

---

Then, let's fix what you already have.

/^.*(?=.{10,})(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[@#$%^&+=]).*$/

should be

/^(?=.{10})(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[@#\$%^&+=])/s

In short, .*.* is (very) slow and useless. Similarly, /.{10,}/ also does needless work compared to /.{10}/. And of course, you didn't mean to use the variable $%.

---

That whole thing means

/.{10}/s && /\d/ && /[a-z]/ && /[A-Z]/ && /[@#\$%^&+=]/

so you could do

lenght() >= 10 && /\d/&&1 + /[a-z]/&&1 + /[A-Z]/&&1 + /[@#\$%^&+=]/&&1
+ == 4
    or die;

or

use List::Util qw( sum );

lenght() >= 10 && sum( /\d/, /[a-z]/, /[A-Z]/, /[@#\$%^&+=]/ ) == 4
    or die;

"&& 1" is required in scalar context since m// is not guaranteed to return 1 for successful matches in scalar context.

---

But you really want that in a match op, don't you?

m{
    (?{ 0 })
    ^
    (?>
        (?=.{10})
        (?=.* \d          (?{ $^R+1 }) | )
        (?=.* [a-z]       (?{ $^R+1 }) | )
        (?=.* [A-Z]       (?{ $^R+1 }) | )
        (?=.* [@#\$%^&+=] (?{ $^R+1 }) | )
    )
    (?(?{ $^R != 3 })(?!))
}xs
    or die;

Update: AnomalousMonk pointed to me that $% is a bug. I adjusted the post accordingly.

[bellaire]

I think that the 10 character minimum is implied to be required, and is not among the optional 4 of which 3 must match.

[ikegami]

I assumed as much and my solutions reflect that.

[bellaire]

As far as my limited skills can determine, you have basically two options:
• Make your regex include all possible 3-out-of-4 permutations and separate them with "or" using |
• Split your matches out into separate regexes, and count how many of them match.
Neither is particularly brief, but I think the latter is more concise and readable. Here's my example of that solution:

if (3 <= scalar grep { $str =~ /$_/ } ( # Match at least 3 of:
    qr/^.*(?=.{10,})(?=.*\d).*$/,
    qr/^.*(?=.{10,})(?=.*[a-z]).*$/,
    qr/^.*(?=.{10,})(?=.*[A-Z]).*$/,
    qr/^.*(?=.{10,})(?=.*[@#$%^&+=]).*$/
   )
) {
    # Do something.
}

[moritz]

Counting in regexes is hard to impossible. One way around this is to write a regex that matches ($digits,$upper,$lower)|($digits,$upper,$extra)|....

Since that's no fun, you can generate it by program:

my @chunks = map qr{(?=.*$_)}, (
   qr{\d},
   qr{[a-z]},
   qr{[A-Z]},
   qr{[@#$%^&+=]},
);

my @transformed;
for my $i (0..$#chunks) {
   my $r = '';
   for my $j (0..$#chunks) {
       $r .= $chunks[$j] if $j != $i;
   }
   push @transformed, $r;
}
my $regex = = join '|', @transformed;
$regex = qr{^.*(?=.{10,})(?:$regex)};

(untested)

But it's much easier to keep the four regexes separate, and in ordinary perl code count how many matched:

my $count = 0;
for (@chunks) {
   $count++ if $str =~ $_;
}

[AnomalousMonk]

Note that $% is a special variable and is interpolated in the  [@#$%^&+=] regex character set. Escape it with a  \ (backslash) instead.

>perl -wMstrict -le
"my $cs1 = qr{ [ab$%cd] }xms;
 print $cs1;
 my $cs2 = qr{ [ab\$%cd] }xms;
 print $cs2;
"
(?msx-i: [ab0cd] )
(?msx-i: [ab\$%cd] )

[AnomalousMonk]

Update: Caution: The code below does not work as advertised! Unfortunately, it was tested only with passwords (I assume the intent of the code is to validate candidate passwords) that met all four of the four optional conditions. Had I tested a password meeting only three of the optional conditions, I would have seen that it was rejected as invalid. Apparently, the  {3,} quantifier at the end of the non-capturing group in the  $valid regex is simply ignored after the warning is issued and Perl just soldiers on. Nobody has called me on this, so I figure I had better 'fess up; I would not want anyone to stumble across this post in the archives someday and be misled onto the path of error. I hope they don't make me give back the XP.

Original Post:
Other than the warning (sorry for the line-wrap munging on this), the following approach seems to work. Except for explicitly suppressing the warning, can anyone think of a way to make this work 'quietly'?

>perl -wMstrict -le
"my $min_10   = qr{ (?= .{10})          }xms;
 my $a_digit  = qr{ (?= .* \d)          }xms;
 my $a_lower  = qr{ (?= .* [[:lower:]]) }xms;
 my $an_upper = qr{ (?= .* [[:upper:]]) }xms;
 my $special  = qr{ [@\#\$%^&+=]        }xms;
 my $a_spec   = qr{ (?= .* $special)    }xms;
 my $valid = qr{
   \A $min_10 (?: $a_digit $a_lower $an_upper $a_spec){3,}
   }xms;
 while (chomp(my $pw = <STDIN>)) {
   my $ok = $pw =~ $valid;
   print qq{'$pw' }, $ok ? 'valid' : 'INVALID';
   }
"
(?: (?msx-i: (?= .* \d)          ) (?msx-i: (?= .* [[:lower:]]) ) (?ms
+x-i: (?= .
* [[:upper:]]) ) (?msx-i: (?= .* (?msx-i: [@\#\$%^&+=]        ))    ))
+{3,}
                    matches null string many times in regex; marked by
+ <-- HERE
in m/                                                                 
+  \A (?msx
-i: (?= .{10})          ) (?: (?msx-i: (?= .* \d)          ) (?msx-i: 
+(?= .* [[:
lower:]]) ) (?msx-i: (?= .* [[:upper:]]) ) (?msx-i: (?= .* (?msx-i: [@
+\#\$%^&+=]
        ))    )){3,}                          <-- HERE / at -e line 1.

'' INVALID

' ' INVALID
x
'x' INVALID
xxxxxxxxx
'xxxxxxxxx' INVALID
xxxxxxxxxx
'xxxxxxxxxx' INVALID
%Aa123456
'%Aa123456' INVALID
%Aa1234567
'%Aa1234567' valid
1aA%23456
'1aA%23456' INVALID
1aA%234567
'1aA%234567' valid
Terminating on signal SIGINT(2)