#!/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.txt' for reading: $!";
while (<$fh>) {
    chomp;

    # 123-4/56 -> 123456 -> push @{data{1}{2}{3}{4}{5}{6}{nodes}}, '123-4/56'
    eval join '', 'push @{$data', (map {defined $l{$_} ? "{$l{$_}}" : ()} split //, $_), "{nodes}}, '$_';";
}

open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for reading: $!";
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 in 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 solution 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 used 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 last dig as last piece
                        print join ' ', @{$work->[PIECES]}, $word, $last_dig;
                        print "\n";
                    }

                    # If the data tree doesn't have a branch for the next 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 $tree->{$last_dig}{nodes};
                }

                # We are not yet at the end, so push each word on to the possible solution queue
                for my $word (@{$tree->{nodes}}) {
                    push @solution, [
                        [@{$work->[PIECES]}, $word],  # Add word to possible solution set
                        $pos + 1,                     # Increment position 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 was a digit
            ];
        }
    }
}