#!/usr/bin/perl use warnings; use strict; use Getopt::Std; my $VERSION = 1; our ($opt_d, $opt_i, $opt_o, $opt_a, $opt_f); getopts 'adi:o:f:'; $\ = $opt_o || "\n"; # Output record separator $/ = $opt_i || "\n"; # Input record separator. Duh. my $file = $opt_f || "/usr/share/dict/words"; my $d = $opt_d; # Debug mode on/off # Initialise these even if -d is on my $word = lc join('', @ARGV); my @letters = sort split(//, $word); my $len = length($word) - 1; undef $word; # These are only needed if we'll be running the code my $secs = time unless $d; my (@perms, @skip, $str) unless $d; my $matches = 0 unless $d; (open my $dict, "$file" or die "Can't read the dictionary: $!\n") unless $d; my $code; for (0 .. $len) { $code .= <<'CODE'; for (0 .. $#letters) { $str .= $letters[$_]; splice @letters, $_, 1; chomp($word ||= <$dict> || last); my $cmp = (lc $word cmp $str); if ($cmp == -1) { undef $word; splice @letters, $_, 0, chop $str; redo; } elsif ($cmp) { splice (@letters, $_, 0, chop $str), next if lc($word) !~ /^$str/; } else { CODE $code .= ' print $word' . ($opt_a ? ' if length $word == ' . ($len + 1) : ";\n\t\t\$matches++") . ";\n}\n"; } for (0 .. $len) { $code .= " splice \@letters, \$_, 0, chop \$str;\n}\n"; } print $code if $d; unless ($d) { eval $code; undef $\; die "Error evaluating: $@\n" if $@; $secs = time - $secs; print "$matches matches found. Search took $secs seconds.\n"; } __END__ =head1 NAME wordsin - a script to find the number of words that can be made from the letters of another. Can also return only acronyms. =head1 SYNOPSIS wordsin [options] word =head1 DESCRIPTION Runs through every possible permutation of a word, checking to see if it's in a specified dictionary. It runs blazingly fast - 'irreversible' takes a single second on my machine, and even a..z takes less than a minute. The dictionary (which defaults to /usr/share/dict/words if none is specified with the -f switch) must be sorted in alphabetical order, one word per record, or Bad Things will probably happen. It is case-insensitive, but non-alphanumerics are treated the same as everything else. =head1 OPTIONS =over =item -a Only find acronyms. =item -d Debug mode. Don't try to find anything, just print out the code that would be used to do so. It's not pretty, but it should be readable. =item -fFILE Use FILE as the dictionary. Default is /usr/share/dict/words, but it would probably be more productive to just change the script instead of using this option. =item -iSTRING Sets $/ (the input record separator) to STRING =item -oSTRING Sets $\ (the output record separator) to STRING. This value is only used while printing options. =back =head1 BUGS =over =item * If it tests permutations past the end of the dictionary (eg. 'zurich' when the dictionary doesn't pass 'zebra', a few warning messages will be displayed. =back =head1 PREREQUISITES strict warnings Getopt::Std =pod SCRIPT CATEGORIES Search =pod OSNAMES any =cut