#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Loops qw/NextPermute NestedLoops/;
use Integer::Partition::Unrestricted; # see http://perlmonks.org/?node
+_id=533164

my %lookup = (
    E => 0, e => 0, J => 1, j => 1, N => 1, n => 1, Q => 1, q => 1, R 
+=> 2, r => 2,
    W => 2, w => 2, X => 2, x => 2, D => 3, d => 3, S => 3, s => 3, Y 
+=> 3, y => 3,
    F => 4, f => 4, T => 4, t => 4, A => 5, a => 5, M => 5, m => 5, C 
+=> 6, c => 6,
    I => 6, i => 6, V => 6, v => 6, B => 7, b => 7, K => 7, k => 7, U 
+=> 7, u => 7,
    L => 8, l => 8, O => 8, o => 8, P => 8, p => 8, G => 9, g => 9, H 
+=> 9, h => 9,
    Z => 9, z => 9
);

my ($fh, $part, %data) = (undef, Integer::Partition::Unrestricted->new
+(), ());

open($fh, '<', 'dictionary.txt') or die "Unable to open 'dictionary.tx
+t' for reading: $!";
while (<$fh>) {
    chomp;
    my $num = join '', map {defined $lookup{$_} ? $lookup{$_} : ()} sp
+lit //, $_;
    push @{$data{$num}}, $_;
}
$data{$_} = [$_] for 0 .. 9;

open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for rea
+ding: $!";
while (<$fh>) {
    chomp;
    my $num = $_;
    $num =~ s/\D//g;
    my $next = $part->gen_iter(length($num));
    while (my @part = sort {$a <=> $b} $next->()) {
        my $ones = "@part" =~ tr/1//;
        next if $ones > ((@part - 1) / 2 + 1);
        my $ok = 1;
        while ($ok) {
            next if "@part" =~ /\b1 1\b/;
            my $template = join '', map {'A' . $_} @part;
            my @dig = unpack($template, $num);
            next if grep {! defined $data{$_}} @dig;
            my @solution = map {[@{$data{$_}}]} @dig;
            my $iter = NestedLoops( \@solution );
            while (my @list = $iter->()) {
                print "$_: @list\n";
            }
        }
        continue {
            $ok = NextPermute(@part);
        }
    }
}
[download]