#!/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 = "\n$table\n
"; } my $template = do { local $/; }; $template =~ s/(\$\w+)/$1/gee; print $cgi->header, $template; __END__

What are the words in your phone number?

If your phone number is $text, then the $words it matches are...


$table