print "bad monkey!" if $pass =~ /(.)\1\1/;
[download]

Let me see if I get it all. You're using a backreference variable to a dot match (.), which is any character. How come \1 and not $1?

Time flies like an arrow, fruit flies like banannas

$_ = "294384333PL";
if ( /(.)\1{2}/ ) {
 print "Three Identical Chars in a ROW: $1";
}
[download]

-enlil

Set of expressions? Bah! Why not just use a single one? ;)

use re 'eval';

my $username = "jryan";
my $password = "perl6rules";

print $password =~ /
    (?=  [^\d]*\d )
    (?=  [^a-z]*[a-z] )
    (?=^ (?: (?!(.)\1\1) . )+ $)
    (?!^ \Q$username\E $)
    (?!^ (??{quotemeta reverse $username}) $)
    ^\w{8,12}$
/ix ? "(-:" : ")-:";
[download]

Note: I also assumed you meant "cannot" for rule 5.

Abigail

Abigail is correct and as such is my time for fun with math (woohoo!).



Number of possible passwords lost by forcing one character to be alpha
+: 1111100000000
Number of possible passwords lost by forcing one character to be numer
+ic: 9.92461065750669e+16
Number of possible passwords lost by forcing at least one character to
+ be alpha and one to be numeric: 9.92472176750669e+16
[download]

Hmmm...that's quite a few passwords.

Updated: Doing math after 10PM isn't one of my strong points.



antirice    
The first rule of Perl club is - use Perl
The ith rule of Perl club is - follow rule i - 1 for i > 1

The number isn't quite that high. Consider:

Total Possible - Actual Possible = Total Lost
(36^8 + 36^9 + 36^10 + 36^11 + 36^12) - ((36^6 + 36^7 + 36^8 + 36^9 + 
+36^10)*10*26) = TL
36^6 * ((36^2 + 36^3 + 36^4 + 36^5 + 36^6) - ((36^0 + 36^1 + 36^2 + 36
+^3 + 36^4)*10*26)) = TL
36^6 * (2,238,976,080 - 449,177,300) = TL
3,896,002,369,298,350,080 = Total Lost
[download]

Although 19 digits is hardly a trivial amount (-:

Never thought of that. Maybe they had trouble parsing those characters or didn't think it all the way through

Time flies like an arrow, fruit flies like banannas

and I changed #5 to _CANNOT_ be userid or reverse of userid, otherwise ...

#!/usr/bin/perl -w

use strict;

my $password = "10diresu";

my $userid = "userid00";

print "huzzah\n" if _check_password($password, $userid);

sub _check_password {
  my ($password, $userid) = @_;

  return undef if ! $password or ! $userid;
  
  my $rev_id = reverse $userid;

  my $rule1   = qr(^[\w\d]{8,12}$);
  my $rule2   = qr((?:[a-zA-Z]\d)|(?:\d[a-zA-Z]));
  my $rule3   = qr(_);
  my $rule4   = qr((.)\1{2}); # thanx Enlil
  my $rule5 = qr($userid|$rev_id);

  if ($password =~ $rule1   and
      $password =~ $rule2   and
      $password !~ $rule3   and
      $password !~ $rule4   and
      $password !~ $rule5) {
    return 1;
  }
  return 0;
}
[download]

if I was doing this in anger, I'd wrap this in a module and write a .t file with ad infinitum test cases - consider this a prototype