—
—

              
#!/usr/bin/perl
HideShow 11 lines of Pod
=begin metadata
Name: look
Description: find lines in a sorted list
Author: Tom Christiansen, tchrist@perl.com
License: perl
=end metadata
=cut
# look - display lines beginning with a given search
use strict;
use locale;
use File::Basename qw(basename);
use Getopt::Std qw(getopts);
use Search::Dict;
use constant EX_FOUND    => 0;
use constant EX_NOTFOUND => 1;
use constant EX_FAILURE  => 2;
my $Program = basename($0);
sub usage {
    warn "usage: $Program [-df] string [file]\n";
    exit EX_FAILURE;
}
my (
    @dicts,     # file list
    $filearg,   # optional file argument
    $search,    # the string to look for
    %opt,       # option hash
);
getopts('df', \%opt) or usage();
@dicts = qw(
    /usr/dict/words
    /usr/share/dict/words
);
$search = shift;
if (!defined($search)) {
    warn "$Program: missing search pattern\n";
    usage();
}
$filearg = shift;
if (@ARGV) {
    warn "$Program: extra argument: '$ARGV[0]'\n";
    usage();
}
if (defined $filearg) {
    @dicts = ($filearg);
} else {
    @opt{ qw/d f/ } = (1, 1);
}
$search = squish($search);
my $dict = open_dict();
my $rc = lookfile($dict);
unless (close $dict) {
    warn "$Program: can't close dictionary: $!\n";
    exit EX_FAILURE;
}
exit $rc;
sub open_dict {
    my $fh;
    for my $file (@dicts) {
        if (-d $file) {
            warn "$Program: '$file' is a directory\n";
            next;
        }
        unless (open $fh, '<', $file) {
            warn "$Program: can't open '$file': $!\n" unless is_default_dict();
            next;
        }
        return $fh;
    }
    warn "$Program: No dictionaries available (@dicts)\n" if is_default_dict();
    exit EX_FAILURE;
}
sub lookfile {
    my $fh = shift;
    if (look($fh, $search, $opt{'d'}, $opt{'f'}) == -1) {
        return EX_NOTFOUND;
    }
    my $match = EX_NOTFOUND;
    while (<$fh>) {
        last if (index(squish($_), $search) != 0);
        $match = EX_FOUND;
        print;
    }
    return $match;
}
sub squish {
    my $str = shift;
    $str = lc($str)         if $opt{'f'};
    $str =~ s/[^\w\s]//g    if $opt{'d'};
    return $str;
}
sub is_default_dict {
    return !defined($filearg);
}
__END__
HideShow 59 lines of Pod
=head1 NAME
look - find lines in a sorted list
=head1 SYNOPSIS
    look [-df] string [file]
=head1 DESCRIPTION
Look uses a binary search against a sorted file to print out
all lines that begin with the given string.  It does make
use of Perl's C<use locale> pragma.
The B<-d> and B<-f> options affect comparisons as in sort(1):
=over
=item -d
`Dictionary' order: only non-alphanumerics and underscores
participate in comparisons.
=item -f
Fold.  Upper case letters compare equal to lower case.
=back
If no file is specified, F</usr/dict/words> (or F</usr/share/dict/words>
if the former is missing) is  assumed with a collating sequence B<-df>.
=head1 FILES
/usr/dict/words
/usr/share/dict/words
=head1 SEE ALSO
sort(1), grep(1), L<perllocale>
=head1 BUGS
I<look> has no known bugs.
=head1 AUTHOR
The Perl implementation of I<look> was written by Tom Christiansen,
I<tchrist@perl.com>.
=head1 COPYRIGHT and LICENSE
This program is copyright (c) Tom Christiansen 1999.
This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.