home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / lotus / eSuite.exe / eSuiteDPP / doc / devpack / lookup.pl < prev    next >
Perl Script  |  1998-01-06  |  6KB  |  244 lines
  1. #!/perl/bin
  2.  
  3. # $Header:   //reebok/xyzL/JavaComp/webpack/doc/common/lookup.pl   1.3   02 Oct 1997 11:38:04   rflynn  $
  4. # ------------------------------------------------------------
  5. # lookup.pl
  6. #
  7. # lookup
  8. # 
  9. # ------------------------------------------------------------
  10. # Maintenace Log
  11. # --------------
  12.  
  13.  
  14.  
  15. &html_header ("Kona Doc Search Results");  # from cgi-lib.pl
  16.  
  17.  
  18. # Get the input
  19.  
  20. &parse_request;
  21. #
  22. #  If debugging on, show all the keys and values from the form.
  23. #
  24. #   if ($query{'debug'} =~ /no debug/) { }
  25. #   else{
  26. #  &show_debug_info;  }
  27. #
  28. #  If name missing, let them retry the form.
  29. #
  30. if ($query{'name'} eq "") {
  31.  
  32.    print "<h2>Error!  It seems you did not enter a keyword.</h2><p>";
  33.    print "<A HREF=\"search_script.pl\">";
  34.    print "Try Again? </A>   <hr>";
  35.  
  36.    &home;   # let them go back home if they want to.
  37.    exit 1;
  38.               }
  39. #this line sets the name of the three column text file
  40. $rolodex = "target2.txt";
  41.  
  42. &field_head();  # for the Results columns.
  43.  
  44. print"<HR>";
  45. $hitctr = 0;  # hit counter variable
  46.  
  47. open(ROLODEX, $rolodex) || die "cannot open $rolodex data file";
  48. #
  49. #  Mod:  use Dict flag = 0 - *all* characters 
  50. #
  51. &look(*ROLODEX, $query{'name'},0,1);  # use the assoc array
  52.  
  53. while (<ROLODEX>){
  54.  
  55.       last unless /^$query{'name'}/i;
  56.       @line = split(/\s\s+/);
  57.       $hitctr++;
  58.       if ($hitctr > $query{'limit-List'}) {
  59.           $hitctr--;  # must adjust this to get it right.
  60.           print "<i>User limit of $hitctr reached...ending search.</i>";
  61.          last;  }
  62.      
  63.     
  64.        print "<pre>";
  65.           $X="<A HREF=http://kona-dpp.lotus.com/dpp_doc/$line[2] Target=_top>$line[1]</A><BR>";
  66.         printf("  %-20s   %-15s   ",$line[0],$X);
  67.        print "</pre>";
  68.  
  69. }   # end of WHILE
  70.  
  71.  
  72. close(ROLODEX) || die "cannot close $rolodex data file";   
  73.  
  74. print "Your search found <b>$hitctr</b> item(s).<p>";
  75. print "<A HREF=\"search_script.pl\">New</A> search?";  
  76.  
  77. # 
  78. &home;
  79. exit 0;
  80.  
  81. sub field_head{
  82.   $fhdr="<B>Keyword</B>";
  83.   $chdr="<B>Topic</B>";
  84. #  $shdr="<B>Link</B>";
  85.   print "<pre>";
  86.   printf(" %-25s    %-20s      ",$fhdr, $chdr);
  87.   print "</pre>";
  88. }  
  89.  
  90. sub show_debug_info {
  91.  
  92. while (($key,$value) = each(%query)) {
  93.    print "The value of $key is $value <br>"; }
  94.  
  95. }
  96.  
  97. exit 0;  
  98.  
  99. ;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
  100.  
  101. ;# Sets file position in FILEHANDLE to be first line greater than or equal
  102. ;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
  103.  
  104. sub look {
  105.     local(*FH,$key,$dict,$fold) = @_;
  106.     local($max,$min,$mid,$_);
  107.     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  108.        $blksize,$blocks) = stat(FH);
  109.     $blksize = 8192 unless $blksize;
  110.     $key =~ s/[^\w\s]//g if $dict;
  111.     $key =~ y/A-Z/a-z/ if $fold;
  112.     $max = int($size / $blksize);
  113.     while ($max - $min > 1) {
  114.     $mid = int(($max + $min) / 2);
  115.     seek(FH,$mid * $blksize,0);
  116.     $_ = <FH> if $mid;        # probably a partial line
  117.     $_ = <FH>;
  118.     chop;
  119.     s/[^\w\s]//g if $dict;
  120.     y/A-Z/a-z/ if $fold;
  121.     if ($_ lt $key) {
  122.         $min = $mid;
  123.     }
  124.     else {
  125.         $max = $mid;
  126.     }
  127.     }
  128.     $min *= $blksize;
  129.     seek(FH,$min,0);
  130.     <FH> if $min;
  131.     while (<FH>) {
  132.     chop;
  133.     s/[^\w\s]//g if $dict;
  134.     y/A-Z/a-z/ if $fold;
  135.     last if $_ ge $key;
  136.     $min = tell(FH);
  137.     }
  138.     seek(FH,$min,0);
  139.     $min;
  140. }
  141.  
  142. 1;
  143.  
  144. #
  145. #  file: cgi-lib.pl
  146. #
  147. #  auth: Brad Burdick
  148. #  desc: This library deals with basic CGI POST or GET method request
  149. #        elements such as those delivered by an HTTPD form, i.e. a url
  150. #        encoded line:  a=b&b=c&c=d
  151. #
  152. #        Also handles <ISINDEX> GET requests.
  153. #
  154. #           
  155. #
  156.  
  157. #
  158. # parse_request reads the POST or GET request from STDIN, and then splits
  159. # it into its name=value pairs.  Special test for <ISINDEX> input.
  160. #
  161. sub parse_request {
  162.  
  163.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  164.         # assumes read gets everything!!
  165.         read(STDIN, $raw_query, $ENV{'CONTENT_LENGTH'});
  166.     } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
  167.         $raw_query = $ENV{'QUERY_STRING'};
  168.     } else {
  169.         # unrecognized request method
  170.         return;
  171.     }
  172.  
  173.     # Decode HEX values and spaces, if any
  174.     if ($raw_query !~ /[&=]/) {  # handle <ISINDEX> input
  175.         $isindex = $raw_query;
  176.         &decode_url($isindex);
  177.     } else {
  178.         %query = &decode_url(split(/[&=]/, $raw_query));
  179.     }
  180. }
  181.  
  182. #
  183. #    Decode a URL encoded string or array of strings 
  184. #        + -> space
  185. #        %xx -> character xx
  186. #
  187. sub decode_url {
  188.     foreach (@_) {
  189.         tr/+/ /;
  190.         s/%(..)/pack("c",hex($1))/ge;
  191.     }
  192.     @_;
  193. }
  194.  
  195. #
  196. # html_header sends an HTML header for the document to be returned
  197. #
  198. sub html_header {
  199.     local($title) = @_;
  200.     print "Content-type: text/html\n\n";
  201.     print "<html><head>\n";
  202.     print "<title>$title</title>\n";
  203.     print "</head>\n<body BGCOLOR=white>\n";
  204. }
  205.  
  206.  
  207. # keep require happy
  208. 1;
  209.  
  210.  
  211. #-------------------------#
  212. # Standard EDGAR Routines #
  213. #-------------------------#
  214.  
  215. #
  216. #  Supply the go-home and back.gif link.
  217. #
  218. sub home{
  219.   local ($gif,$text) = @_; 
  220.  
  221.   # if nothing supplied, set default to back.gif and vanilla caption.
  222.   
  223.   if ($#_ < 0) {   # check out the funky $#_ !!
  224.       $gif = "back.gif";
  225.       $text = "Return to the Programmatic Reference Home Page";
  226. } 
  227.  
  228. print "<HR>";
  229. print "<a href=\"http://kona-dpp.lotus.com/dpp_doc/prog_ref_home.html\" target=_top>";
  230. print "<img src=\"http://kona-dpp.lotus.com/dpp_doc/$gif\">";
  231. print "$text</A>";
  232. print "<HR>";
  233. }
  234.  
  235. 1;  # it is CRITICAL to end a subroutine library with a 1;
  236.     # or else, no requires using this would work.
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.