develooper Front page | perl.perl6.users | Postings from January 2009

Scripting competition: password solution

Thread Next
Richard Hainsworth
January 8, 2009 07:04
Scripting competition: password solution
Message ID:
Here's a solution to the scripting competition test. Patrick suggested 
publishing solutions somewhere, including this list.

Patrick Michaud suggested 
( writing solutions to
scripting game definitions as a way of experimenting with perl6.

This program is a suggested solution to event 5, strong passwords, in 
the scripting games. The scenario is described at

So here is my first attempt. I have kept to the definition in the 
competition, even though this means hard coding the top score (13) and 
evaluation points (11,7).

Although I suppose part of the competition is to get funcky ways of 
solving the problem, I just used a straightforward implimentation of the 
They are so easy in perl6! The only real problem is to associate a test 
with the string to be printed when a test fails.

use v6;

my $pw = @*ARGS[0];
my @msg;

# Here we have an array of rules that if matched yield a test failure as 
per the game, and the error string to go with it.
my @rules = (
    [{!(10 < .chars < 20)},'Length is under 10 or over 20 characters'],
# Note the .chars! This will be called as the argument of a when clause 
and so $_ will contain the value of $pw.
    [ / ^ <-digit>+ $ / , 'Does not contain a digit'],
 I think this is so neat! It took a while and an email from Patrick to 
 <digit> is supplied by PGE (perl6 grammar engine). So by definition, 
<-digit> is not a digit.
 A string that does not contain a digit will consist entirely of 
non-digits. Hence by "stretching" the
 match pattern from the start ^ of the string to the end of the string $ 
with a pattern containing
 as many chars as necessary +, we match a string without a single digit.
    [ / ^ <-upper>+ $ / , 'Does not contain an upper case letter'],
    [ / ^ <-lower>+ $ / , 'Does not contain an lower case letter'],
    [ / ^ <alnum>+ $ / , 'Does not contain a symbol character'],
    [ / <lower> **4 / , 'Four or more lower case characters in succession'],
    [ / <upper> **4 / , 'Four or more upper case characters in succession'],
    [ / (.) [.+] $0 / , 'A duplicate character with same case is used']
 Developing and testing a pattern that yielded a duplicate character 
ignoring case was so easy it took two minutes to
 work out and test.

 In order to see how a pattern would work out, I compiled perl6 to an 
executable and put a link to it in /usr/local/bin
 then perl6 on the command line in a console and something like
 >my $x='abcedeA';$x~~m/<upper>/??say 'M' !! say 'NM'
 The > is the prompt from perl6. The M is the response.
 What's nice is that a simple cursor-up brings back the previous line 
for experimenting.

 see below for why the next section is commented out
#my @rules4list = (
#    ['', m/ (:i $pw) /,'Matches a real word'],
#    ['s/^ . (.*) $ / $0 /', / (:i $pw) /, 'Matches a real word without 
the first character'],
#    ['s/^ (.*) . $/ $0 /', / (:i $pw) /,'Matches a real word without 
the last character'],
#    ['tr/O/0/', / (:i $pw) /, 'Matches a real word with digit 0 in 
place of letter O'],
#    ['tr/l/1/', / (:i $pw) /, 'Matches a real word with digit 1 in 
place of letter l']
#my $orig;

if $pw { # trap zero-length passwords

 This commented out section does not work because three things do not 
appear to have been implimented:
 a) m/$pw/ matching a scalar. According to S05 the should be passed raw 
to the matching engine and treated as a string if it does not contain a rule
 b) s///
 c) tr///
 It might not work even so due to some error I've missed.

#    my $words = open('wordlist.txt', :r) or die $!;
#    for =$words {
#    for @rules4list -> @r {
#        $orig = $_;
#        eval(@r[0]);
#        when @r[1] { push @msg, @r[2] }
#    };
#    };

    given $pw {
    for @rules -> @r {
        when @r[0] { push @msg, @r[1] }
 Isnt perl6 compact? Five lines to run all the tests against $pw and 
capture any error messages
 'given' moves the password automatically to $_
 'for' takes each of the array and puts it into @r, in this case another 
array because @rules is an array of arrays
 'when' applies the test statement to $_, and if a boolean true is the 
result, the next block pushes the message onto the array
 Note that one of the tests was a bare block, which is treated as code, 
while the others were bare regexen. when does the rest
 Since an error message is pushed onto the array for each failure 
condition, the size of the array gives the score.

    say 'A password score of '
    ~ 13 - @msg.elems
    ~ ' indicates a '
    ~ (given 13 - @msg.elems {
        when $_ > 10 { 'strong'}
        when $_ > 7 { 'moderately strong'}
        default { 'weak' }
    ~ ' password';
 Here I used the fact that the value of a 'given' block is the value of 
the last block. Since a 'when' block 'breaks' out of the block when 
'called', it is easy
 to create three (in this case) strings depending on the three condtions 
and interpolate them directly into the say string.

    for @msg {.say};
 This is all I need to print out on separate lines an entire array!

} else {
    say 'No password given';

Thread Next Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About