#!/usr/bin/perl
use CGI;
use DB_File;
use strict;
# open the index mapping phone digit sequences to English words
tie my(%db), "DB_File", "phone_words.db", O_RDONLY, 0666, $DB_HASH;
sub phone_words {
# get the phone # from the argument list. strip out non-numerics.
my $number = shift; $number =~ s/\D//gos;
# start a list of results.
my @accept;
# iterate through each position in the phone number
for (my $start = 0; $start < length($number); $start++) {
# iterate backwards through each possible sequence of digits,
# anchored at position $start
for (my $len = length($number) - $start; $len > 0; $len--) {
# $try is the sub-sequence of digits from the phone number
# that we're interested in right now.
my $try = substr($number, $start, $len);
my @choices;
# Build up a list of strings to look up in the index.
# If this string of numbers goes to the end of our phone number,
# add all possible "extra" digits (e.g. DUSK-MAZE)
my @attempt = $try;
push @attempt, map("$try$_", 2 .. 9) if $start + $len == length($number);
# For each sequence we look up in the word index, get the list of
# matching words, and break them up, storing in @choices
for my $n (@attempt) {
my $choices = $db{$n} or next;
push @choices, grep {$_} split /(.{@{[length($n)]}})/, $choices;
}
# failing all else, we will accept using the sequence directly in our
# solution, if it's only one digit
push @choices, $try if length($try) == 1;
# if we got this far and nothing matches in the index, bail on this sequence
next unless @choices;
# then we found some choices we can add to our list of existing solutions,
# and if we aren't starting at the beginning of the phone number
if ($start > 0) {
# iterate through all the partial solutions we've already found
for my $item (@accept) {
# and if there's partial solutions that end at this starting point
if (($item =~ y/-//c) == $start) {
# create a new entry that consists of each old partial
# solution ending here plus a hyphen plus each of the
# words we just found matching the current sequence
push @accept, "$item-$_" for @choices;
}
}
} else {
# Otherwise seed the list of results with all the words matching this
# sequence
push @accept, @choices;
}
}
}
# Fix all the places where we ended up with dashes between digits.
@accept = map { 1 while s/(\d)-+(\d)/$1$2/gos; $_ } @accept;
# Filter out solutions that end up having the wrong number of digits.
@accept = grep( y/-//c >= length $number, @accept );
# Filter out the solutions that have three or more consecutive digits,
# a hyphen-digit-digit-hyphen sequence, or have more than three hyphens
# as being all lame.
@accept = grep( !/\d{3,}|-\d\d-/o && y/-/-/ < 3, @accept );
# Filter out "extra digit" solutions that end with the digit as being lame.
@accept = grep( y/-//c == length $number || !/\d$/o, @accept );
# Sort our results list by descending quantity of hyphens.
@accept = map { $_->[0] }
sort { $a->[1] <=> $b->[1] || $b->[0] cmp $a->[0] }
map { [$_, scalar y/-/-/] } @accept;
return @accept;
}
### CGI schtuff below here
my $cgi = CGI->new;
my $text = $cgi->textfield( -name => "number", -size => 12 );
my $words = $cgi->submit( -value => "words" );
my $table = "";
if (my $number = $cgi->param("number")) {
my @results = phone_words($number);
while (my @row = splice(@results, 0, 5)) {
$#row = 4;
$table .= "| "
. join(" | ", map($_ || " ", @row))
. " |
\n";
}
$table ||= "| ... apparently, nothing worth remembering! |
";
$table = "";
}
my $template = do { local $/; };
$template =~ s/(\$\w+)/$1/gee;
print $cgi->header, $template;
__END__
What are the words in your phone number?
$table