home *** CD-ROM | disk | FTP | other *** search
/ ftp.sunet.sepub/pictures / 2014.11.ftp.sunet.se-pictures.tar / ftp.sunet.se / pub / pictures / ACiD-artpacks / www / mirrors / hirez / cgi-bin / discus / board-search.cgi < prev    next >
Text File  |  1999-02-12  |  12KB  |  391 lines
  1. #!/usr/bin/perl
  2. $discus_conf = '/usr/local/www/www.hirez.org/discus_admin_149349189/discus.conf';
  3. #Discus board search script
  4. #-------------------------------------------------------------------------------
  5. # This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved.
  6. # Its use is subject to the license agreement that can be found at the following
  7. # URL:  http://www.chem.hope.edu/discus/license
  8. #-------------------------------------------------------------------------------
  9. # To enable multiple selection of topics, you can enable one of
  10. # the following two options.  However, this makes the interface
  11. # look not-so-good.
  12. # $multiple =  "MULTIPLE SIZE=1";
  13. # $multiple =  "MULTIPLE";
  14. #------------------------------------------------------------------------------
  15. if (open (FILE, "$discus_conf")) {
  16.     @file = <FILE>;
  17.     close (FILE);
  18.     $evals = "";
  19.     foreach $line (@file) {
  20.         if ($line =~ /^(\w+)=(.*)/) {
  21.             $varname = $1;
  22.             $value = $2;
  23.             $value =~ s/'/\\'/g; $value =~ s/\r//g;
  24.             $evals .= "\$$varname='$value'; ";
  25.         }
  26.     }
  27.     eval($evals);
  28.     require "$admin_dir/source/src-board-subs-common";
  29. } else {
  30.     print "Content-type: text/html\n\n";
  31.     print "<HTML><HEAD><TITLE>Script Execution Error</TITLE></HEAD>\n";
  32.     print "<BODY BGCOLOR=#ffffff TEXT=#000000>\n";
  33.     print "<H1>Script Execution Error</H1>\n";
  34.     print "Discus scripts could not execute because the discus.conf file\n";
  35.     print "could not be opened.";
  36.     print "<P>Reason: <FONT COLOR=#ff0000><B>$!</B></FONT>" if $!;
  37.     print "<P>This generally indicates a setup error of some kind.\n";
  38.     print "Consult the <A HREF=\"http://www.chem.hope.edu/discus/rc\">Discus ";
  39.     print "Resource Center</A> for troubleshooting information.</BODY></HTML>\n";
  40.     exit(0);
  41. }
  42. &parse_form;
  43. &read_cookie;
  44. if ($FORM{'query'} eq "") {
  45.     ($bg, $tx, $li, $vl, $al, $face, $size, $image) = &ex('extract_colorsonly', 1);
  46.     $str = "$L{BSCH_TITLE}";
  47.     open (TOPIC, "$message_dir/board-topics.html");
  48.     @topic = <TOPIC>;
  49.     close (TOPIC);
  50.     $optionstring = "";
  51.     foreach $line (@topic) {
  52.         if ($line =~ /<!-Top: (\d+)-!>/) {
  53.             $num = $1;
  54.             &extract ("//$num/$num.$ext");
  55.             if (-e "$message_dir/$num") {
  56.                 $optionstring .= "<OPTION VALUE=\"$me_number\">$me_name\n";
  57.             } else {
  58.                 @auth = &ex('validate_auths', $num);
  59.                 $optionstring .= "<OPTION VALUE=\"$me_number\">$me_name\n" if grep(/^$num$/, @auth);
  60.             }                
  61.         }
  62.     }
  63.     &header;
  64.     &ex('printuntil', 1, 1, 0, "$L{BSCH_TITLE}");
  65.     print <<EOFILE;
  66. <FONT SIZE=4><CENTER><B>$L{BSCH_TITLE}</B></CENTER></FONT>
  67. <HR>
  68. <FORM ACTION="$script_url/board-search.$cgi_extension" METHOD=POST>
  69. $L{BSCH_INSTR}<P>
  70. <TABLE>
  71. <TR>
  72. <TD><FONT FACE="$face" SIZE="$size"><B>$L{BSCH_SEARCHFOR}</B></FONT></TD>
  73. <TD><INPUT SIZE=35 NAME=query TYPE=TEXT></TD>
  74. </TR>
  75. <TR>
  76. <TD><FONT FACE="$face" SIZE="$size"><B>$L{BSCH_TOPICS}</B></FONT></TD>
  77. <TD><SELECT NAME=searchwhere $multiple>
  78. EOFILE
  79.     print "<OPTION VALUE=ALL>$L{BSCH_ALLTOPICS}\n";
  80.     if ($pro) {
  81.         &ex('get_preferences', 1);
  82.         if ($PREF{'favorites'} ne "") {
  83.             print "<OPTION VALUE=\"$PREF{'favorites'}\" SELECTED>$L{MY_FAVORITES}\n";
  84.         }
  85.     }    
  86.     print $optionstring;
  87.     print "</SELECT></TD></TR>\n";
  88.     print <<EOFORM;
  89. <TR>
  90. <TD><FONT FACE="$face" SIZE="$size"><B>$L{BSCH_LOOKIN}</B></FONT></TD>
  91. <TD><SELECT SIZE=1 NAME=lookin>
  92. <OPTION VALUE=1>$L{BSCH_TITLESOF}
  93. <OPTION VALUE=2>$L{BSCH_AUTHORS}
  94. <OPTION VALUE=3 SELECTED>$L{BSCH_TEXT}
  95. <OPTION VALUE=4>$L{BSCH_ALLOFTHESE}
  96. </SELECT></TD>
  97. </TR>
  98. <TR>
  99. <TD><FONT FACE="$face" SIZE="$size"><B>$L{BSCH_TYPEOFPAGE}</B></FONT></TD>
  100. <TD><SELECT SIZE=1 NAME=typepage>
  101. <OPTION VALUE=1>$L{BSCH_TYPEOFPAGE_1}
  102. <OPTION VALUE=3>$L{BSCH_TYPEOFPAGE_3}
  103. </SELECT></TD>
  104. </TR>
  105. <TR>
  106. <TD><FONT FACE="$face" SIZE="$size"><B>$L{BSCH_LIMITTO}</B></FONT></TD>
  107. <TD><SELECT SIZE=1 NAME=limit>
  108. <OPTION VALUE=1>$L{BSCH_LIMIT_1DAY}
  109. <OPTION VALUE=2>$L{BSCH_LIMIT_2DAY}
  110. <OPTION VALUE=7>$L{BSCH_LIMIT_7DAY}
  111. <OPTION VALUE=14>$L{BSCH_LIMIT_14DAY}
  112. <OPTION VALUE=30 SELECTED>$L{BSCH_LIMIT_30DAY}
  113. <OPTION VALUE=0>$L{BSCH_LIMIT_NONE}
  114. </SELECT></TD>
  115. </TR>
  116. </TABLE>
  117. <P>
  118. EOFORM
  119.     print "<INPUT TYPE=SUBMIT VALUE=\"$L{BSCHBUTTONTEXT}\"></TD></TR></TABLE>";
  120.     print "</FORM>\n";
  121.     &ex('printuntil', 3, 17, 0, "", 0, 1);
  122.     exit(0);
  123. }
  124. $q = $FORM{'query'};
  125. $w = $FORM{'searchwhere'};
  126. $l = $FORM{'lookin'};
  127. $t = $FORM{'limit'};
  128. $y = $FORM{'typepage'};
  129. # Build up topics list that is to be searched
  130. undef @topics;
  131. open (TOPICS, "$message_dir/board-topics.html"); @tf = <TOPICS>; close (TF);
  132. @tf2 = grep(/<!-Top:/, @tf);
  133. foreach $line (@tf2) {
  134.     if ($line =~ m|<!-Top: (\d+)-!>|) {
  135.         $topic = $1;
  136.         if (-e "$message_dir/$topic") {
  137.             $secured{$topic} = 0;
  138.             push (@topics, $topic) if (grep(/^$topic$/, split(/,/, $w)) || $w eq "ALL");
  139.         } else {
  140.             $secured{$topic} = 1;
  141.             @auth = &ex('validate_auths', $topic);
  142.             if (grep(/^$topic$/, @auth)) {
  143.                 push (@topics, $topic) if (grep(/^$topic$/, split(/,/, $w)) || $w eq "ALL");
  144.             }
  145.         }
  146.     }
  147. }
  148. # Build up list of files that are to be searched
  149. undef @files; undef @match; undef %seenfile;
  150. if ($l == 3 || $t != 0 || $l == 2 || $y == 1) {
  151.     $timecutoff = time - (60*60*24*$t) if $t;
  152.     open (LOG, "$admin_dir/log.txt"); @LOG = <LOG>; close (LOG);
  153.     foreach $line (reverse(@LOG)) {
  154.         ($index, $who, $time, $where, $ip1, $ip2, $source, $postby) = split(/;/, $line);
  155.         $postby{$where} = "$index-----$postby\n$postby{$where}";
  156.         next if $seenfile{$where};
  157.         last if $time < $timecutoff;
  158.         ($tn, $pn) = split(/\//, $where);
  159.         if (grep(/^$tn$/, @topics)) {
  160.             push (@files, $where);
  161.             $seenfile{$where} = 1;
  162.         } 
  163.     }
  164. } else {
  165.     foreach $topic (@topics) {
  166.         &recurse_find($topic, $topic);
  167.     }
  168.     if ($l == 4) {
  169.         open (LOG, "$admin_dir/log.txt"); @LOG = <LOG>; close (LOG);
  170.         foreach $line (reverse(@LOG)) {
  171.             ($index, $who, $time, $where, $ip1, $ip2, $source, $postby) = split(/;/, $line);
  172.             $postby{$where} = "$index-----$postby\n$postby{$where}";
  173.         }    
  174.     }
  175. }
  176. # Score each page based on hits
  177. undef %score;
  178. undef %context;
  179. undef %wordseen;
  180. while ($q =~ m|"([^"]+)"|g) {
  181.     $b = $`; $a = $';
  182.     $m = $1; $m =~ s/\s/!!!SPACE!!!/g;
  183.     $q = join("", $b, $m, $a);
  184. }
  185. @words = split(/\s+/, $q);
  186. foreach $word (@words) {
  187.     if ($word =~ m|^-|) {
  188.         $r = -1; $word = $';
  189.     } elsif ($word =~ m|^\+|) {
  190.         $r = 1; $word = $';
  191.     } else {
  192.         $r = 0;
  193.     }
  194.     $word =~ s/!!!SPACE!!!/ /g;   # Undo space conversion above
  195.     $word = &escape_input($word); # Make search string escaped as when posting
  196.     $word =~ s/([^\w\s])/\\$1/g;    # Quote any possible meta characters
  197.     if ($r == -1) {
  198.         push (@badword, $word);
  199.     } elsif ($r == 1) {
  200.         push (@require, $word);
  201.     }    
  202. }
  203. @words = grep(/\S/, @words);
  204. foreach $where (@files) {
  205.     ($topic, $page) = split(/\//, $where);
  206.     if ($head{$where} eq "") {
  207.         ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page);
  208.     }
  209.     if ($l == 1 || $l == 4) {
  210.         while ($head{$where} =~ m|<!--Level (\d+): (\d+)/(.*)-->|g) {
  211.             $ms = $3;
  212.             foreach $word (@words) {
  213.                 while ($ms =~ m|$word|ig) {
  214.                     $wordseen{$where} .= "\n$word\n";
  215.                     $score{$where} += 1;
  216.                 }
  217.             }
  218.         }
  219.     }
  220.     if ($l == 2 || $l == 4) {
  221.         $ms = &unescape($postby{$where});
  222.         foreach $word (@words) {
  223.             while ($ms =~ /(.*)($word)(.*)/gi) {
  224.                 $wordseen{$where} .= "\n$word\n";
  225.                 $score{$where} += 1;
  226.                 $o = $1; $t = $2; $h = $3;
  227.                 if ($o =~ m|^(\d+)-----|) {
  228.                     $o = $'; $m = $&;
  229.                 }
  230.                 $context{$where} .= "$m$L{BSCH_AUTHOR} $o$t$h\n";
  231.             }
  232.         }
  233.     }
  234.     if ($l == 3 || $l == 4) {
  235.         while ($message{$where} =~ m|<!-Post: (\d+)-!>([\s\S]+)<!-/Post: \1-!>|g) {
  236.             $postnum = $1; $ms = $2;
  237.             $ms =~ m|<P>\n(.*)\s+(.*)|; $o = $1; $t = $2;
  238.             if ($o =~ m|^<!-NOTE:|) {
  239.                 $ms = $t;
  240.             } else {
  241.                 $ms = $o;
  242.             }
  243.             # Note:  the following code was written this way because of a bug
  244.             # in SGI Perl 4...  I know it's dreadful :)
  245.             while ($ms =~ /<IMG SRC="[^"]*" ALT="([^"]*)">/) {
  246.                 $ms = join("", $`, "[$2]", $');
  247.             }
  248.             while ($ms =~ /<([^>]*)>/) {
  249.                 $ms = join("", $`, $');
  250.             }
  251.             while ($ms =~ /&#(\d+);/) {
  252.                 $ms = join("", $`, $');
  253.             }
  254.             # End Perl 4 workaround
  255.             foreach $word (@words) {
  256.                 # Another workaround
  257.                 $msg = $ms;            
  258.                 while ($msg =~ m|($word)|i) {
  259.                     $msg = $';
  260.                     $a = substr($', 0, 30); $b = substr($`, -30, 30); $w = $1;
  261.                     $a =~ m|^(.*)|; $a = $1;
  262.                     $b =~ m|(.*)$|; $b = $1;
  263.                     $score{$where} += 1;
  264.                     $wordseen{$where} .= "\n$word\n";
  265.                     $context{$where} .= "$postnum-----$b$w$a\n";
  266.                 }
  267.             }
  268.         }
  269.     }
  270. }
  271. foreach $file (@files) {
  272.     if ($score{$file} == 0) {
  273.         $file = ""; next;
  274.     }
  275.     foreach $w (@badword) {
  276.         $file = "" if $wordseen{$file} =~ m|\n$w\n|;
  277.     }
  278.     foreach $w (@require) {
  279.         $file = "" if $wordseen{$file} !~ m|\n$w\n|;
  280.     }
  281. }
  282. @files_s = sort by_score (grep(/\S/, @files));
  283. &header;
  284. &ex('printuntil', 1, 1, 0, "$L{BSCHRESULTS}");
  285. print "<FONT SIZE=+1><CENTER><B>$L{BSCHRESULTS}</B></CENTER></FONT><HR>\n";
  286. $pages = scalar(@files_s);
  287. if ($pages == 0) {
  288.     $reply = $L{BSCH_0HITS};
  289. } elsif ($pages == 1) {
  290.     $reply = $L{BSCH_1HIT};
  291. } else {
  292.     $reply = $L{BSCH_MANYHITS};
  293. }
  294. $q = $FORM{'query'};
  295. $reply =~ s/\%query/$q/g;
  296. $reply =~ s/\%results/$pages/g;
  297. print $reply;
  298. print "<P>\n";
  299. $mc = 0;
  300. foreach $file (@files_s) {
  301.     undef %cs; $where = $file;
  302.     ($topic, $page) = split(/\//, $file);
  303.     if ($head{$where} eq "") {
  304.         ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page);
  305.     }
  306.     @head = split(/\n/, $head{$file});
  307.     ($topicstr) = grep(/<!--Topic: (\d+)/, @head);
  308.     $topicstr =~ m|<!--Topic: (\d+)/(.*)-->|; $topic = $1;
  309.     $navbar = $2;
  310.     foreach $line (@head) {
  311.         if ($line =~ m|<!--Level \d+: \d+/(.*)-->|) {
  312.             $navbar .= ": $1";
  313.         }
  314.     }
  315.     $mc += 1;
  316.     print "$mc. ";
  317.     $show = "<A HREF=\"$message_url/$file.$ext" if $secured{$topic} == 0;
  318.     $show = "<A HREF=\"$script_url/board-auth.$cgi_extension?file=/$file.$ext&lm=$lm{$file}" if $secured{$topic} == 1;
  319.     $show .= "?$lm{$file}" if (!$noqm && $secured{$topic} == 0);
  320.     print $show;
  321.     print "\"><B>";
  322.     print $navbar;
  323.     print "</B></A>\n";
  324.     print "<BLOCKQUOTE><FONT SIZE=-1>\n";
  325.     foreach $word (@words) {
  326.         $context{$file} =~ s/($word)/<B>$1<\/B>/gi;
  327.     }
  328.     @context = split(/\n/, $context{$file}); @context = grep(/\S/, @context);
  329.     $ctr = 0;
  330.     foreach $line (@context) {
  331.         next if $cs{$line};
  332.         if ($line =~ m|^(\d+)-----|) {
  333.             $pn = $1; $line = $';
  334.             $line =~ s/<B>([^<]+)<\/B>/$show#POST$pn"><B>$1<\/B><\/A>/g;
  335.         }
  336.         print "$L{BSCH_DOT} $line<BR>\n";
  337.         $cs{$line} = 1; $ctr += 1;
  338.         last if $ctr > 7;
  339.     }
  340.     print "</FONT></BLOCKQUOTE>\n";
  341.     print "<P>\n";
  342. }
  343. &ex('printuntil', 3, 17, 0, "", 0, 1);
  344. exit(0);
  345. sub by_score {
  346.     return -1 if $score{$a} > $score{$b};
  347.     return 1 if $score{$b} > $score{$a};
  348.     return 0;
  349. }
  350. sub recurse_find {
  351.     local ($topic, $page) = @_;
  352.     local ($where, $line);
  353.     $where = "$topic/$page";
  354.     ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page);
  355.     foreach $line (split(/\n/, $sublist{$where})) {
  356.         if ($line =~ m|<!-Top: (\d+)-!>|) {
  357.             &recurse_find($topic, $1);
  358.         }
  359.     }
  360.     push (@files, $where);
  361. }
  362. sub search_get_page {
  363.     ($topic, $page) = @_;
  364.     return ("", "", "", "") if ($topic == 0 || $page == 0);
  365.     local ($file, $temp);
  366.     $temp = $/;
  367.     undef $/;
  368.     if ($secured{$topic} == 0) {
  369.         open (FILE, "$message_dir/$topic/$page.$ext");
  370.     } else {
  371.         open (FILE, "$secdir/$topic/$page.$ext");
  372.     }
  373.     ($file) = <FILE>;
  374.     close (FILE);
  375.     $file =~ m|<HTML>|; $head = $`;
  376.     $file =~ m|\s<A NAME="(\w+)">|; $lm = $1;
  377.     $file =~ m|<!--Messages-->([\s\S]*)<!--/Messages-->|; $msg = $1;
  378.     $file =~ m|<!--Sublist-->([\s\S]*)<!--/Sublist-->|; $sl = $1;
  379.     $/ = $temp;
  380.     return ($head, $lm, $sl, $msg);
  381. }
  382. sub escape_input {
  383.     local ($stringin) = @_;
  384.     $_ = $stringin;
  385.     s/&/&/g; s/</\</g; s/>/\>/g; s/"/"/g; s/\\\\/\/g;
  386.     s/\\\{/{/g; s/\\\}/}/g; s/\\,/,/g; s/\(/(/g;
  387.     s/\)/)/g; s/\[/[/g; s/\]/]/g; s/\*/*/g; s/\+/+/g;
  388.     s/\|/|/g; s/'/'/g; s/\r\n/\n/g; s/\r/\n/g; s/\n/ <BR>/g;
  389.     return $_;
  390. }
  391.