[comp.lang.perl] Lookup

cristy@eplrx7.uucp (John Cristy) (11/13/90)

I use the following perl program to search USENET groups for articles with
a specified pattern.  Hope you find it useful:

   lookup <pattern>
   lookup -comp.lang.perl <pattern>

cristy@dupont.com

-----

#!/bin/perl -w
#
#  Lookup recursively descends a directory and lists files that contain the 
#  specified patterns.
#
#  Command usage:
#
#    lookup [ -newsgroup ] pattern [ pattern ... ]
#
#
sub lookup 
{
  local($directory)=shift;
  local($file);
  local(@filelist);
  chdir $directory || die "Can't change to directory $directory.\n";
  #
  # Sort list of directory and filenames.
  #
  opendir(DIRECTORY,$directory);
  @filelist=sort(grep(!/^\.\.?$/,readdir(DIRECTORY)));
  closedir(DIRECTORY);
  foreach $file (@filelist) 
  {
    if (-d $file) 
      {
        #
        # File is a directory-- descend to the next level.
        #
        do lookup("$directory/$file");
        chdir $directory || die "Can't change to directory $directory.\n";
      }
    else 
      {
        #
        # Read contents of file.
        #
        open(FILE,$file);
        @content=<FILE>;
        close(FILE);
        #
        # Determine if file contains all the specified patterns.
        #
        foreach $pattern (@patterns)
        {
          @result=grep(/$pattern/,@content);
          if ($#result < 0)
            {
              #
              # File does not contain the pattern-- exit loop.
              #
              last;
            }
        }
        if ($#result >= 0)
          {
            #
            # File contains the pattern-- list it.
            #
            print "\n$directory/$file:\n";
            print "\n@content\n";
            print "\n---\n";
          }
      }
  }
}

if ($#ARGV < 0)
  {
    print "Usage: lookup [ -newsgroup ] pattern [ pattern ... ]\n";
    exit(1);
  }
undef $/;
$*=1;
$directory="/usr/usenet/news";
if ($ARGV[0] =~ /^-/)
  {
    #
    # User specified newsgroup.
    #
    $newsgroup=shift(@ARGV);
    $newsgroup=~s/^-//;  # delete '-'
    $newsgroup=~s/\./\//g;  # convert newsgroup to directory
    $directory=$directory. "/" . $newsgroup;
  }
@patterns=@ARGV;
do lookup("$directory");
--
The UUCP Mailer