Fifth Script: First Working Version

colomon on 2009-01-10T17:59:11

After a couple of weeks' layoff from this project, I got back to work at 4am last night. I never successfully interpolated a variable in a regex like originally wanted to. Luckily, I realized a simple string equality test was all that was needed. After that, everything went very quickly, the only complications being the modified pattern matching syntax.

This code doesn't strike me as wildly Perl6ish, but I suspect this is how I might do day-to-day programming in Perl 6 -- sort of a sturdy traditional Perl 5 structure with little dabs of convenient new stuff. This may be the first time I've ever really used grep -- I was never fully comfortable with the Perl 5 syntax for it for some reason -- and it makes me happy. This code isn't brilliant, but I like it.

my $wordfile = "wordlist.txt";

my @words = do
{
    my $words = open($wordfile) // die "Unable to open $wordfile: $!\n";
    =$words;
};

for (@*ARGS) -> $password
{
    say;
    say $password;
    
    my $score = 13;
    
    my %dictionary_checks;
    %dictionary_checks{$password.subst(/0/, "o").lc} 
                    = "Password is word with ohs changed to zeroes.";    
    %dictionary_checks{$password.subst(/1/, "l").lc} 
                    = "Password is word with ells changed to ones.";                    
    %dictionary_checks{$password.lc} 
                        = "Password is a word in the dictionary.";
    %dictionary_checks{$password.chop.lc} 
                        = "Password minus last character is a word in the dictionary.";
    %dictionary_checks{$password.substr(1).lc}
                        = "Password minus first character is a word in the dictionary.";
    
    my @hits = grep { %dictionary_checks.exists($^a) }, @words;
    for @hits -> $trouble
    {
        $score--;
        say "{%dictionary_checks{$trouble}}";
    }
    
    if ($password.elems < 10 || $password.elems > 20)
    {
        $score--;
        say "Password should be 10-20 characters.";
    }
    
    unless ($password ~~ /\d/)
    {
        $score--;
        say "Password should have a digit in it.";
    }
    
    unless ($password ~~ /<[A..Z]>/)
    {
        $score--;
        say "Password should have an uppercase letter in it.";
    }
    
    unless ($password ~~ /<[a..z]>/)
    {
        $score--;
        say "Password should have a lowercase letter in it.";
    }
    
    unless ($password ~~ /\W/)
    {
        $score--;
        say "Password should have a non-alphanumeric character in it.";
    }
    
    if ($password ~~ /<[A..Z]>**4/)
    {
        $score--;
        say "Password has four uppercase letters in a row.";
    }
    
    if ($password ~~ /<[a..z]>**4/)
    {
        $score--;
        say "Password has four lowercase letters in a row.";
    }
    
    my %letter_freq;
    for $password.split('') -> $x
    {
        %letter_freq{$x}++;
    }
    if (%letter_freq.values.max > 1)
    {
        $score--;
        say "Password has duplicate characters.";
    }
    
    say "Score: $score";
}

That last test (the %letter_freq one) compiled and worked on the first try, probably my biggest "Perl 6 just works" moment so far.

I'm a bit uncomfortable with all the repetition in there. I can imagine making the code more elegant by wrapping up the tests as closures and mapping them to the messages, but it seems like that would make it more obscure. Possibly a well-written function (macro of some sort?) to wrap the notion of test, failure message, and dock points?