Here is the same code re-written to be more clear and maintainable. I still think the handful of special case scenarios could be reduced to a more general case. Unfortunately, I don't have time to try.

`#!/usr/bin/perl
use constant PIECES => 0;
use constant POSITION => 1;
use constant USED_DIG => 2;
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;
# 123-4/56 -> 123456 -> push @{data{1}{2}{3}{4}{5}{6}{nodes}}, '12
+3-4/56'
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;
# Make a copy of original phone number for readability (not $_)
my $orig_num = $_;
# Make a copy of phone number using just digits
my $num = join '', /(\d+)/g;
# Determine the position of last digit in phone number for substr
my $end = length($num) - 1;
# Special case - if single digit, print it and move on
if (! $end) {
print "$orig_num: $num\n";
next;
}
# Initialize potential solution queue
my @solution = ([
["$orig_num:"], # pieces of solution
0, # position in $num to look for next piece
0 # boolean to indicate last piece was not digit
]);
while (@solution) {
# Get a reference to our data tree
my $tree = \%data;
# Get a potential solution off the queue
my $work = pop @solution;
# Boolean indicating we have not yet found the next piece of a
+ solution
my $found = 0;
# Record the first digit in the next solution piece. Needed i
+n case no words found
my $first = substr($num, $work->[POSITION], 1);
# Find all possible words from the current position to the end
+ of $num
for my $pos ($work->[POSITION] .. $end) {
# Get the digit associated with the current position
my $dig = substr($num, $pos, 1);
# There are no possible solutions beyond this point in the
+ $num
if (! exists $tree->{$dig}) {
# If we have not yet found a solution and didn't use a
+ digit in last piece
if (! $work->[USED_DIG] && ! $found) {
# Indicate we found the next piece of solution
$found = 1;
# Use a digit as the next piece and put the soluti
+on back on the work queue
push @solution, [
[@{$work->[PIECES]}, $first], # Add digit to
+possible solution set
$work->[POSITION] + 1, # Increment the
+ position by 1
1 # Indicate we u
+sed a digit for last piece
];
# No more possible solutions can exist, so move on
last;
}
}
# Move one step down in our data tree
$tree = $tree->{$dig};
# If any words can be found at this depth
if (exists $tree->{nodes}) {
# Indicate we found the next piece of solution
$found = 1;
# If we are at the end of the phone number
if ($pos == $end) {
# For each word found
for my $word (@{$tree->{nodes}}) {
# Print all the pieces of the solution
print join ' ', @{$work->[PIECES]}, $word;
print "\n";
}
# No more possible solutions can exist (end of num
+), so move on
last;
}
# If only one digit remains in the phone number
if ($end - $pos == 1) {
# Grab that last digit
my $last_dig = substr($num, $end, 1);
# For each word found at current position
for my $word (@{$tree->{nodes}}) {
# Print all the pieces of the solution using l
+ast dig as last piece
print join ' ', @{$work->[PIECES]}, $word, $la
+st_dig;
print "\n";
}
# If the data tree doesn't have a branch for the n
+ext digit
# Or if the branch for the next digit has no word
+nodes
# Then no more possible solutions, so move on
last if ! exists $tree->{$last_dig} || ! exists $t
+ree->{$last_dig}{nodes};
}
# We are not yet at the end, so push each word on to t
+he possible solution queue
for my $word (@{$tree->{nodes}}) {
push @solution, [
[@{$work->[PIECES]}, $word], # Add word to po
+ssible solution set
$pos + 1, # Increment posi
+tion by 1
0 # Indicate last
+piece was not a digit
];
}
}
}
# If we made it all the way to the end
# And we did not find a possible solution
# And the last piece found was not a digit
# Use the first digit seen as a possible piece
if (! $found && ! $work->[USED_DIG]) {
push @solution, [
[@{$work->[PIECES]}, $first], # Add digit to possible
+ solution set
$work->[POSITION] + 1, # Increment position by
+ 1
1 # Indicate last piece w
+as a digit
];
}
}
}
`

Comment onRe^3: One for the weekend: challengeDownloadCode