#!/usr/bin/perl $discus_conf = '/home/cultur/www/discus_admin_24003/discus.conf'; #Discus board search script #------------------------------------------------------------------------------- # This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved. # Its use is subject to the license agreement that can be found at the following # URL: http://www.chem.hope.edu/discus/license #------------------------------------------------------------------------------- # To enable multiple selection of topics, you can enable one of # the following two options. However, this makes the interface # look not-so-good. # $multiple = "MULTIPLE SIZE=1"; # $multiple = "MULTIPLE"; #------------------------------------------------------------------------------ if (open (FILE, "$discus_conf")) { @file = ; close (FILE); $evals = ""; foreach $line (@file) { if ($line =~ /^(\w+)=(.*)/) { $varname = $1; $value = $2; $value =~ s/'/\\'/g; $value =~ s/\r//g; $evals .= "\$$varname='$value'; "; } } eval($evals); require "$admin_dir/source/src-board-subs-common"; } else { print "Content-type: text/html\n\n"; print "Script Execution Error\n"; print "\n"; print "

Script Execution Error

\n"; print "Discus scripts could not execute because the discus.conf file\n"; print "could not be opened."; print "

Reason: $!" if $!; print "

This generally indicates a setup error of some kind.\n"; print "Consult the Discus "; print "Resource Center for troubleshooting information.\n"; exit(0); } &parse_form; &read_cookie; if ($FORM{'query'} eq "") { ($bg, $tx, $li, $vl, $al, $face, $size, $image) = &ex('extract_colorsonly', 1); $str = "$L{BSCH_TITLE}"; open (TOPIC, "$message_dir/board-topics.html"); @topic = ; close (TOPIC); $optionstring = ""; foreach $line (@topic) { if ($line =~ //) { $num = $1; &extract ("//$num/$num.$ext"); if (-e "$message_dir/$num") { $optionstring .= "

$L{BSCH_TITLE}

\n"; &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } $q = $FORM{'query'}; $w = $FORM{'searchwhere'}; $l = $FORM{'lookin'}; $t = $FORM{'limit'}; $y = $FORM{'typepage'}; # Build up topics list that is to be searched undef @topics; open (TOPICS, "$message_dir/board-topics.html"); @tf = ; close (TF); @tf2 = grep(/|) { $topic = $1; if (-e "$message_dir/$topic") { $secured{$topic} = 0; push (@topics, $topic) if (grep(/^$topic$/, split(/,/, $w)) || $w eq "ALL"); } else { $secured{$topic} = 1; @auth = &ex('validate_auths', $topic); if (grep(/^$topic$/, @auth)) { push (@topics, $topic) if (grep(/^$topic$/, split(/,/, $w)) || $w eq "ALL"); } } } } # Build up list of files that are to be searched undef @files; undef @match; undef %seenfile; if ($l == 3 || $t != 0 || $l == 2 || $y == 1) { $timecutoff = time - (60*60*24*$t) if $t; open (LOG, "$admin_dir/log.txt"); @LOG = ; close (LOG); foreach $line (reverse(@LOG)) { ($index, $who, $time, $where, $ip1, $ip2, $source, $postby) = split(/;/, $line); $postby{$where} = "$index-----$postby\n$postby{$where}"; next if $seenfile{$where}; last if $time < $timecutoff; ($tn, $pn) = split(/\//, $where); if (grep(/^$tn$/, @topics)) { push (@files, $where); $seenfile{$where} = 1; } } } else { foreach $topic (@topics) { &recurse_find($topic, $topic); } if ($l == 4) { open (LOG, "$admin_dir/log.txt"); @LOG = ; close (LOG); foreach $line (reverse(@LOG)) { ($index, $who, $time, $where, $ip1, $ip2, $source, $postby) = split(/;/, $line); $postby{$where} = "$index-----$postby\n$postby{$where}"; } } } # Score each page based on hits undef %score; undef %context; undef %wordseen; while ($q =~ m|"([^"]+)"|g) { $b = $`; $a = $'; $m = $1; $m =~ s/\s/!!!SPACE!!!/g; $q = join("", $b, $m, $a); } @words = split(/\s+/, $q); foreach $word (@words) { if ($word =~ m|^-|) { $r = -1; $word = $'; } elsif ($word =~ m|^\+|) { $r = 1; $word = $'; } else { $r = 0; } $word =~ s/!!!SPACE!!!/ /g; # Undo space conversion above $word = &escape_input($word); # Make search string escaped as when posting $word =~ s/([^\w\s])/\\$1/g; # Quote any possible meta characters if ($r == -1) { push (@badword, $word); } elsif ($r == 1) { push (@require, $word); } } @words = grep(/\S/, @words); foreach $where (@files) { ($topic, $page) = split(/\//, $where); if ($head{$where} eq "") { ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page); } if ($l == 1 || $l == 4) { while ($head{$where} =~ m||g) { $ms = $3; foreach $word (@words) { while ($ms =~ m|$word|ig) { $wordseen{$where} .= "\n$word\n"; $score{$where} += 1; } } } } if ($l == 2 || $l == 4) { $ms = &unescape($postby{$where}); foreach $word (@words) { while ($ms =~ /(.*)($word)(.*)/gi) { $wordseen{$where} .= "\n$word\n"; $score{$where} += 1; $o = $1; $t = $2; $h = $3; if ($o =~ m|^(\d+)-----|) { $o = $'; $m = $&; } $context{$where} .= "$m$L{BSCH_AUTHOR} $o$t$h\n"; } } } if ($l == 3 || $l == 4) { while ($message{$where} =~ m|([\s\S]+)|g) { $postnum = $1; $ms = $2; $ms =~ m|

\n(.*)\s+(.*)|; $o = $1; $t = $2; if ($o =~ m|^/) { $ms = join("", $`, "[$2]", $'); } while ($ms =~ /<([^>]*)>/) { $ms = join("", $`, $'); } while ($ms =~ /&#(\d+);/) { $ms = join("", $`, $'); } # End Perl 4 workaround foreach $word (@words) { # Another workaround $msg = $ms; while ($msg =~ m|($word)|i) { $msg = $'; $a = substr($', 0, 30); $b = substr($`, -30, 30); $w = $1; $a =~ m|^(.*)|; $a = $1; $b =~ m|(.*)$|; $b = $1; $score{$where} += 1; $wordseen{$where} .= "\n$word\n"; $context{$where} .= "$postnum-----$b$w$a\n"; } } } } } foreach $file (@files) { if ($score{$file} == 0) { $file = ""; next; } foreach $w (@badword) { $file = "" if $wordseen{$file} =~ m|\n$w\n|; } foreach $w (@require) { $file = "" if $wordseen{$file} !~ m|\n$w\n|; } } @files_s = sort by_score (grep(/\S/, @files)); &header; &ex('printuntil', 1, 1, 0, "$L{BSCHRESULTS}"); print "

$L{BSCHRESULTS}

\n"; $pages = scalar(@files_s); if ($pages == 0) { $reply = $L{BSCH_0HITS}; } elsif ($pages == 1) { $reply = $L{BSCH_1HIT}; } else { $reply = $L{BSCH_MANYHITS}; } $q = $FORM{'query'}; $reply =~ s/\%query/$q/g; $reply =~ s/\%results/$pages/g; print $reply; print "

\n"; $mc = 0; foreach $file (@files_s) { undef %cs; $where = $file; ($topic, $page) = split(/\//, $file); if ($head{$where} eq "") { ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page); } @head = split(/\n/, $head{$file}); ($topicstr) = grep(/|; $topic = $1; $navbar = $2; foreach $line (@head) { if ($line =~ m||) { $navbar .= ": $1"; } } $mc += 1; print "$mc. "; $show = ""; print $navbar; print "\n"; print "

\n"; foreach $word (@words) { $context{$file} =~ s/($word)/$1<\/B>/gi; } @context = split(/\n/, $context{$file}); @context = grep(/\S/, @context); $ctr = 0; foreach $line (@context) { next if $cs{$line}; if ($line =~ m|^(\d+)-----|) { $pn = $1; $line = $'; $line =~ s/([^<]+)<\/B>/$show#POST$pn">$1<\/B><\/A>/g; } print "$L{BSCH_DOT} $line
\n"; $cs{$line} = 1; $ctr += 1; last if $ctr > 7; } print "

\n"; print "
\n"; } &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); sub by_score { return -1 if $score{$a} > $score{$b}; return 1 if $score{$b} > $score{$a}; return 0; } sub recurse_find { local ($topic, $page) = @_; local ($where, $line); $where = "$topic/$page"; ($head{$where}, $lm{$where}, $sublist{$where}, $message{$where}) = &search_get_page($topic, $page); foreach $line (split(/\n/, $sublist{$where})) { if ($line =~ m||) { &recurse_find($topic, $1); } } push (@files, $where); } sub search_get_page { ($topic, $page) = @_; return ("", "", "", "") if ($topic == 0 || $page == 0); local ($file, $temp); $temp = $/; undef $/; if ($secured{$topic} == 0) { open (FILE, "$message_dir/$topic/$page.$ext"); } else { open (FILE, "$secdir/$topic/$page.$ext"); } ($file) = ; close (FILE); $file =~ m||; $head = $`; $file =~ m|\s|; $lm = $1; $file =~ m|([\s\S]*)|; $msg = $1; $file =~ m|([\s\S]*)|; $sl = $1; $/ = $temp; return ($head, $lm, $sl, $msg); } sub escape_input { local ($stringin) = @_; $_ = $stringin; s/&/&/g; s//\>/g; s/"/"/g; s/\\\\/\/g; s/\\\{/{/g; s/\\\}/}/g; s/\\,/,/g; s/$/(/g; s/$/)/g; s/\[/[/g; s/\]/]/g; s/\*/*/g; s/\+/+/g; s/\|/|/g; s/'/'/g; s/\r\n/\n/g; s/\r/\n/g; s/\n/
/g; return $_; }

$L{BSCH_SEARCHFOR}
$L{BSCH_TOPICS}
$L{BSCH_LOOKIN}
$L{BSCH_TYPEOFPAGE}
$L{BSCH_LIMITTO}