#!/usr/pkg/bin/perl

=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__

=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.
