"Programming with Perl"
by Randal L. Schwartz
Web Techniques, April 1997

Web Techniques grants permission to use these listings for private or 
commercial use provided that credit to Web Techniques and the author is 
maintained within the comments of the source. For questions, contact
editors@web-techniques.com.

[LISTING ONE]

#!/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;