#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: word_search,v 1.11 1996/08/24 15:25:18 ejb Exp $
# $Source: /home/ejb/scripts/RCS/word_search,v $
# $Author: ejb $
#
# This script searches a list of files (given on the commandline as a
# filename containing the list) for words listed in a special
# wordfile.  The wordfile is simply a list of words to be searched
# for.	Each line is considered a word.	 All text following the #
# character is ignored.  Blank lines are ignored.  For the list of files,
# comments and blank lines are also ignored.  The filename is taken as the
# first white-space-separated column on the line.  One file is specified
# on each line.
#

# XXX See comment for revision 1.9 -> 1.10 in the log file for
# description of bug.

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)/[^/]+$,) ? $1 : ".";

# Make output and error unbuffered
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

my $verbose = 0;

&usage if (scalar(@ARGV != 2));

my ($filelist, $wordlist) = (@ARGV);

open(WORDLIST, "<$wordlist") ||
    die "$whoami: failure opening $wordlist for reading: $!\n";

my @exps = ();
while (<WORDLIST>)
{
    chop;
    s/\#.*//;			# remove comments
    m/^\s*$/ && next;		# skip blank lines
    s/\s*$//;			# remove trailing blanks
    s/\s+/[^A-Za-z]\*/g;	# replace blanks with regexp for
				# non-alphabetic characters
    push(@exps, "^([0-9]+: .*" . $_ . ".*\$)");
}

close(WORDLIST);

open(FILELIST, "<$filelist") ||
    die "$whoami: failure opening $filelist for reading: $!\n";

my @files = ();
while (<FILELIST>)
{
    chop;
    s/\#.*//;			# remove comments
    m/^\s*$/ && next;		# skip blank lines
    s/^([^\s]*).*$/$1/;		# Extract first column
    push(@files, $_);
}

close(FILELIST);

# Allow embedded newlines to be matched by ^ and $

for (@files)
{
    my $file = $_;
    my $message = "==> Searching in $file; ";
    if (! open(FILE, "<$file"))
    {
	$message .= "error opening $file read/only: $!\n";
	print STDERR $message;
	next;
    }

    # Read in file numbering the lines.
    my $contents = "";
    while (<FILE>)
    {
	$contents .= $. . ": " . $_;
    }

    close(FILE);

    my $output = "";
    for (@exps)
    {
	while ($contents =~ m/$_/img)
	{
	    $output .= $1 . "\n";
	}
    }

    if ($output eq "")
    {
	$message .= "okay.\n";
	print $message if $verbose;
    }
    else
    {
	$message .= "!!! keywords found: !!!\n";
	print $message;

	my @output = split('\n', $output);
	my $last = "";
	for (sort numeric @output)
	{
	    print $_, "\n" if ($_ ne $last);
	    $last = $_;
	}
    }
}

sub numeric
{
    $a =~ m/^([0-9]+):.*/;
    my $c = $1;
    $b =~ m/^([0-9]+):.*/;
    my $d = $1;
    $c <=> $d;
}

sub usage
{
    warn "Usage: $whoami file-list word-list\n";
    exit 1;
}