#!/usr/sup/gnu/bin/perl

=head1 NAME

match - A program to search for words matching a pattern

=head1 SYNOPSIS

B<match> [ C<-r> ] I<pattern>

=head1 DESCRIPTION

B<match> will search /usr/dict/words for words matching I<pattern>.
A pattern is a sequence of letters. A pattern match a word if it has
the same "structure", e.g. the pattern 'ABBA' match the words 'deed',
'noon', 'peep', 'poop', 'teet', 'toot' but not 'toad', 'toast', 'toomb.'

The patterns are case-independent, i.e. 'ABBA' and 'abBA' are
equivalent patterns.

The search proceeds by constructing a regular expression from the
pattern and then searching the dictionary using it.

=head1 OPTIONS

=over 4
=item -r
Print the generated regular expression to standard output. Performs no
dictionary search.

=head1 FILES

    /usr/dict/words     words list

=head1 AUTHOR

Matz Kindahl @ DoCS (Uppsala University)

=head1 SEE ALSO

perl(1), look(1), perlre(1)

=cut

$SIG{__DIE__} = sub {
    die "$_[0]Usage: $& [ -r ] <pattern>\n";
};

# 'getopts' seems to be broken here.
while ($ARGV[0] =~ /^-/) {
    if ($ARGV[0] =~ /-r/) {
	$opt_r = shift;
    } else {
	die "Illegal option $ARGV[0]\n";
    }
}
die "No pattern supplied!\n"
    unless @ARGV > 0;
die "Only alphanumerics allowed in pattern!\n"
    if $ARGV[0] =~ /\W/;

$ARGV[0] =~ tr/a-z/A-Z/;	# Turn into upper-case

foreach (split(//, $ARGV[0])) {
    if ($G{$_}) {
	$RE .= "\\" . $G{$_};
    } else {
	$RE .= $N ? "(?!\\" . join("|\\",values(%G)) . ')(\w)' : '(\w)';
	$G{$_} = ++$N;
    }
}

if ($opt_r) {
    print "$RE\n";
} else {
    open(DICT, "/usr/dict/words") or die "Cannot open dictionary\n";
    while (<DICT>) {
	print if /^$RE$/io;
    }
}