home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 September / PCWorld_2000-09_cd.bin / Komunik / sambar / _setup.1 / search.pl < prev    next >
Text File  |  1998-01-08  |  3KB  |  165 lines
  1.  
  2. #
  3. # Perl-based Search Engine
  4. #
  5. # Copyright 1998 Tod Sambar
  6. # All rights reserved.
  7. #
  8.  
  9. my $docroot = $ENV{'DOCUMENT_ROOT'};
  10. my $docrootlen = length($docroot);
  11.  
  12.  
  13. #
  14. # PARSE THE CGI FORM
  15. #
  16.  
  17.     # Buffer the POST content
  18.     read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  19.  
  20.     # Process the name=value argument pairs
  21.     my $pair;
  22.     my $name;
  23.     my $value;
  24.     my @args = split(/&/, $buffer);
  25.  
  26.     foreach $pair (@args) 
  27.     {
  28.         ($name, $value) = split(/=/, $pair);
  29.  
  30.         # Unescape the argument value 
  31.         $value =~ tr/+/ /;
  32.         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  33.  
  34.         # Save the name=value pair for use below.
  35.         $FORM{$name} = $value;
  36.     }
  37.  
  38.  
  39. #
  40. # BUILD THE FILE SEARCH LIST
  41. #
  42. # NOTE:        We only search *.htm, *.html and *.txt files
  43. #
  44. # WARNING:     This search engine is a serious memory hog
  45. #            for large sites with many files.
  46.  
  47.     # Change to the Server's document root
  48.     chdir($docroot);
  49.  
  50.     # Get a list of all matching files
  51.     my $list;
  52.     $list = `dir /b/S *.htm`;
  53.     $list .= `dir /b/S *.html`;
  54.     $list .= `dir /b/S *.txt`;
  55.  
  56.     my @LIST = split(/\s+/, $list);
  57.  
  58.  
  59. #
  60. # SEARCH THE FILES
  61. #
  62.     my $file;
  63.     my $data;
  64.     my $match;
  65.     my $found;
  66.     my $query = $FORM{'query'};
  67.  
  68.     print "Content-type: text/html\n\n";
  69.     print "<HTML><HEAD><TITLE>PERL Search Results</TITLE></HEAD>\n";
  70.     print "<BODY bgcolor=#FFFFFF>\n";
  71.     print "<CENTER>\n";
  72.     print "<FONT SIZE=6 COLOR=#99003><B>Sambar Server</B></FONT><BR>\n";
  73.     print "<FONT SIZE=6 COLOR=#99003><I>PERL Search Results</I></FONT>\n";
  74.     print "</CENTER><P>\n";
  75.     print "<B>Query</B>: <I>".$query."</I><P>\n";
  76.     print "<HR><UL>\n";
  77.  
  78.     my @query = split(/\s+/, $query);
  79.  
  80.     $found = 'no';
  81.  
  82.     foreach $file (@LIST) 
  83.     {
  84.         # Read the file
  85.         open(FILE, "$file");
  86.         @LINES = <FILE>;
  87.         close(FILE);
  88.  
  89.         # Merge the lines of the file together
  90.         $data = join(' ', @LINES);
  91.         $data =~ s/\n//g;
  92.  
  93.         $match = 'no';
  94.  
  95.         if ($FORM{'logic'} eq 'and') 
  96.         {
  97.             foreach $term (@query) 
  98.             {
  99.                 # Perform case insensitive comparison
  100.                 if (!($data =~ /$term/i)) 
  101.                 {
  102.                     # Term did not match.
  103.                     $match = 'no';
  104.                     last;
  105.                 }
  106.                 else 
  107.                 {
  108.                     # Term matched
  109.                     $match = 'yes';
  110.                 }
  111.             }
  112.         }
  113.         elsif ($FORM{'logic'} eq 'or') 
  114.         {
  115.             foreach $term (@query) 
  116.             {
  117.                 if ($data =~ /$term/i) 
  118.                 {
  119.                     # Term matched
  120.                     $match = 'yes';
  121.                     last;
  122.                 }
  123.             }
  124.         }
  125.         else
  126.         {
  127.             print "Unrecognized query logic...\n";
  128.         }
  129.  
  130.         if ($match eq 'yes')
  131.         {
  132.             $found = 'yes';
  133.  
  134.             # Strip off the document root
  135.             $file = substr($file, $docrootlen - 1);
  136.  
  137.             # Fixup the directory slashes
  138.             $file =~ s/\\/\//g;
  139.  
  140.               if ($data =~ /<title>(.*)<\/title>/i) 
  141.             {
  142.                 print "<LI><A HREF=\"$file\"> ".$1."</A><BR>\n";
  143.               }
  144.               else 
  145.             {
  146.                 print "<LI><A HREF=\"$file\"> ".$file."</A><BR>\n";
  147.               }
  148.         }
  149.     }
  150.  
  151.     if ($found eq 'no')
  152.     {
  153.         print "<I><B>No search results.</B></I><BR>\n";
  154.     }
  155.  
  156.     print "\n</UL><HR>\n";
  157.     print "</BODY></HTML>\n";
  158.  
  159.  
  160. #
  161. # DONE
  162. #
  163.  
  164. exit(0);
  165.