#!/usr/bin/perl
use strict;
use warnings;

my %l = (
    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, %data);

open($fh, '<', 'dictionary.txt') or die "Unable to open 'dictionary.tx
+t' for reading: $!";
while (<$fh>) {
    chomp;
    eval join '', 'push @{$data', (map {defined $l{$_} ? "{$l{$_}}" : 
+()} split //, $_), "{nodes}}, '$_';";
}

open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for rea
+ding: $!";
while (<$fh>) {
    chomp;
    my $num = join '', /(\d+)/g;
    my $end = length($num) - 1;
    print "$_: $num\n" and next if ! $end;
    my @solution = [["$_:"], 0, 0];
    while (@solution) {
        my ($tree, $work) = (\%data, pop @solution);
        my ($found, $first) = (0, substr($num, $work->[1], 1));       
        for my $pos ($work->[1] .. $end) {
            my $dig = substr($num, $pos, 1);
            if (! exists $tree->{$dig}) {
                push @solution, [[@{$work->[0]}, $first], $work->[1] +
+ 1, 1] if ! $work->[2] && ! $found++;
                last;
            }
            $tree = $tree->{$dig};
            if (exists $tree->{nodes} && ++$found) {
                if ($pos == $end) {
                    print join(' ', @{$work->[0]}, $_), "\n" for @{$tr
+ee->{nodes}};
                    last;
                }
                if ($end - $pos == 1) {
                    my $last_dig = substr($num, $end, 1);
                    print join(' ', @{$work->[0]}, $_, $last_dig), "\n
+" for @{$tree->{nodes}};
                    last if ! exists $tree->{$last_dig} || ! exists $t
+ree->{$last_dig}{nodes};
                }
                push @solution, [[@{$work->[0]}, $_], $pos + 1, 0] for
+ @{$tree->{nodes}};
            }
        }
        push @solution, [[@{$work->[0]}, $first], $work->[1] + 1, 1] i
+f ! $work->[2] && ! $found;
    }
}
[download]