Initial data commit

Task/Mastermind/Perl/mastermind.pl

@@ -0,0 +1,51 @@
+use List::Util qw(any);
+
+print 'Enter pool size, puzzle size, attempts allowed: ';
+($pool,$length,$tries) = split /\s+/, <>;
+$length =  4 if $length eq '' or $length < 3 or $length > 11;
+$pool   =  6 if $pool   eq '' or $pool   < 2 or $pool   > 21;
+$tries  = 10 if $tries  eq '' or $tries  < 7 or $tries  > 21;
+
+@valid  = sort { -1 + 2*int(rand 2) } ('A' .. 'T')[0..$pool-1];
+@puzzle = @valid[0..$length-1];
+
+$black = '●';
+$white = '○';
+
+while () {
+    header();
+    print "$_\n" for @guesses;
+    lose() if  @guesses == $tries;
+    @guess = get_guess();
+    next unless is_valid(@guess);
+    $score = score(\@puzzle, \@guess);
+    win() if $score eq join ' ', ($black) x $length;
+    push @guesses, join(' ', @guess) . ' :: ' . $score;
+}
+
+sub score {
+    local *puzzle = shift;
+    local *guess  = shift;
+    my @score;
+    for $i (0..$length-1) {
+        if    (     $puzzle[$i] eq $guess[$i]) { push @score, $black }
+        elsif (any {$puzzle[$i] eq $_} @guess) { push @score, $white }
+        else                                   { push @score, '-'    }
+    }
+    join ' ', reverse sort @score;
+}
+
+sub header {
+    $num = $tries - @guesses;
+    print  "Valid letter, but wrong position: ○ - Correct letter and position: ●\n";
+    print  "Guess the $length element sequence containing the letters " . join(', ', sort @valid) . "\n";
+    printf "Repeats are not allowed. You have $num guess%s remaining\n", $num > 1 ? 'es' : '';
+}
+
+sub get_guess { print 'Your guess?: '; $g = <>; return split /\s*/, uc $g }
+
+sub is_valid { $length == @_ }
+
+sub win  { print 'You win! The correct answer is: ' . join(' ',@puzzle) . "\n"; exit }
+
+sub lose { print 'Too bad, you ran out of guesses. The solution was: ' . join(' ',@puzzle) . "\n"; exit }