#! /Users/jj/bin/perl5.10.0

use 5.010;
use strict;
use warnings;

my @tests = (
  make_rule('Password is in word list',
             sub {/^$_$/i ~~ wordlist()} ),
           
  make_rule('Password minus last letter is in word list',
             sub {chop; /^$_$/i ~~ wordlist();} ),

  make_rule('Password minus first letter is in word list',
             sub {$_ = substr $_,1; /^$_$/i ~~ wordlist();} ),

  make_rule('Substitutes "0" (zero) for letter "o"',
             sub {s/0/o/g and /^$_$/i ~~ wordlist();} ),

  make_rule('Substitutes "1" (one) for letter "l"',
             sub {s/1/l/g and /^$_$/i ~~ wordlist();} ),

  make_rule('Length is not between 10 and 20 characters',
             sub{ length($_) < 10 or length($_) > 20 } ),
  
  make_rule('Password does not include a digit',
             sub {$_ !~ /\d/;} ),
           
  make_rule('Password does not include an uppercase letter',
             sub {$_ !~ /[A-Z]/;} ),
           
  make_rule('Password does not include a lowercase letter',
             sub {$_ !~ /[a-z]/;} ),
           
  make_rule('Password does not include a symbol',
             sub {$_ !~ /[^0-9A-Z]/i;} ),
           
  make_rule('Password has 4 lowercase letters in succession',
             sub {$_ =~ /[a-z]{4}/;} ),
           
  make_rule('Password has 4 uppercase letters in succession',
             sub {$_ =~ /[A-Z]{4}/;} ),
           
  make_rule('Password has duplicate characters',
             sub {$_ =~ /(.).*\1/;} ),
);

say "Enter a password to test:";
my $password = <STDIN>;
chomp $password;

my $score = @tests;
foreach my $test (@tests) {
  if (my $message = $test->($password)) {
    $score--;
    say $message;
  }
}

say '';

given ($score) {
  when ($_ >= 11) {
    say "A score of $score indicates a strong password";
  }
  when ([7..10]) {
    say "A score of $score indicates a moderately strong password";
  }
  when ($_ <= 6) {
    say "A score of $score indicates a weak password";
  }
}


#--------------------------------------------------------------------------

sub make_rule {
  # Creates a function to test $_ against the specified rule,
  # returning $message if the rule matches
  my ($message,$rule) = @_;
  return sub {
    local $_ = shift;
    return ($rule->()) ? $message : undef;
  }
}

#--------------------------------------------------------------------------

sub wordlist {
  state @wordlist;
  unless (@wordlist) {
    open WORDLIST,'<','wordlist.txt' or die "Cannot open wordlist.txt: $!";
    @wordlist = map {s/\s//g; $_} (<WORDLIST>);
    close WORDLIST;
  }
  return \@wordlist;
}

#--------------------------------------------------------------------------