#!/home/merlyn/bin/perl -Tw
use strict;
$| = 1;

## set the path
$ENV{"PATH"} = "/usr/local/bin:/usr/ucb:/bin:/usr/bin";

my $header_printed = 0;         # so the death handler knows

## return $_[0] encoded for HTML entities
sub ent {
  local $_ = shift;
  $_ =~ s/["<&>"]/"&#".ord($&).";"/ge;  # entity escape
  $_;
}

## death handler
$SIG{"__DIE__"} = $SIG{"__WARN__"} = sub {
  my $why = shift;
  chomp $why;
  $why = ent $why;
  print "Content-type: text/html\n\n" unless $header_printed++;
  print "ERROR: $why\n";
  exit 0;
};

use CGI qw/:standard/;

my $DIR = "/home/merlyn/Html/merlyn/WebTechniques";
my $URL = "http://www.stonehenge.com/merlyn/WebTechniques";
my $FILEPAT = "*.listing.txt";

print header; $header_printed++;
print start_html("-title" => "Search WebTechniques Perl Scripts");
print h1("Search WebTechniques Perl Scripts");
print "Search the <A HREF=\"$URL/\">Perl WebTechniques programs</A>",
  " by submitting this form:\n";
print hr, start_form;
print p, "Search for: ", textfield("-name" => "search");
print p, checkbox("-name" => "regex", "-label" => "Use Regular Expressions");
print p, checkbox("-name" => "ignore", "-label" => "Ignore case");
print p, submit;
print end_form, hr;

my $searchstring = param("search"); # the search item
if (defined $searchstring and length $searchstring) {
  chdir $DIR or die "Cannot chdir $DIR: $!";
  @ARGV = glob $FILEPAT;        # get matching filenames for <>
  unless (param("regex")) {     # if ordinary string...
    $searchstring = quotemeta $searchstring; # make ordinary.
  }
  my $ignore = param("ignore") ? "(?i)" : ""; # make case insensitive
  print "<P>Follow the link to get the full listing:\n";
  print "<PRE>\n";
  my $per_file = 0;             # how many hits this file?
  while (<>) {
    if (eof) {
      close ARGV;               # resets $.
      $per_file = 0;
    }
    chomp;
    my $per_line = 0;           # how many hits this line?
    while (s/$ignore$searchstring//o) {
      print
        '<A HREF="',ent("$URL/$ARGV"),'">',
        ent($ARGV),"</A>:$.: "
          unless $per_line++;   # first time, print prefix
      print ent($`), b(ent $&);
      $_ = $';
      last if $per_line >= 5;   # only five hits max per line
    }
    if ($per_line) {            # at least one hit?
      print ent($_),"\n";       # finish line off
      if (++$per_file >= 5) {   # only five lines max per file
        print "[skipping to next file]\n";
        close ARGV;             # force EOF
        $per_file = 0;
      }
    }
  }
  print "</PRE>\n";
}

print end_html;