#!C:/Perl/bin/perl.exe $discus_conf = 'd:/inetpub/wwwroot/wielens/discus_admin/discus.conf'; $pro_fileid = '3348162969543224'; #Discus board search script #------------------------------------------------------------------------------- # DISCUS VERSION 3.10 COPYRIGHT NOTICE # # Discus 3.10 is copyright (c) 2000 by DiscusWare, LLC, all rights reserved. # The use of Discus is governed by the Discus License Agreement which is # available from the Discus WWW site at: # http://www.discusware.com/discus/license # # Pursuant to the Discus License Agreement, this copyright notice may not be # removed or altered in any way. #------------------------------------------------------------------------------- # 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"; #------------------------------------------------------------------------------ # # Some other options that are recognized: # boolean=and "And" search (require all terms) # matchtype=wholeword Match entire words # if (open (FILE, "$discus_conf")) { @file = ; close (FILE); foreach $line (@file) { if ($line =~ /^(\w+)=(.*)/) { $varname = $1; $value = $2; $value =~ s/\r//g; ${$varname} = $value; } } 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; &error_message($L{FILELOCKERROR}, $L{NOTICE_MAINTENANCEMODE}, 0, 1, 1) if $GLOBAL_OPTIONS{'maintenance'}; ######################################################################### # CLEANING MECHANISM opendir(DIR, "$admin_dir/msg_index/searches"); while ($file = readdir(DIR)) { next if $file !~ m|^(\d+)\.txt$|; if ((stat("$admin_dir/msg_index/searches/$file"))[9] < (time - 30*60)) { # >30 minutes old unlink("$admin_dir/msg_index/searches/$file"); } } closedir(DIR); ######################################################################### # OPENING FORM if ($FORM{'query'} eq "" && $FORM{'tempfile'} eq "") { ($bg, $tx, $li, $vl, $al, $face, $size, $image) = &ex('extract_colorsonly', 1); $str = "$L{BSCH_TITLE}"; open (TOPIC, "$message_dir/$board_topics_file"); @topic = ; close (TOPIC); $optionstring = ""; foreach $line (@topic) { if ($line =~ //) { $num = $1; &extract ("//$num/$num.$ext"); if (-e "$message_dir/$num") { $optionstring .= "

$L{BSCH_TITLE}
$L{BSCH_INSTR}

\n"; print <
$L{BSCH_SEARCHFOR}
$L{BSCH_TOPICS}
$L{BSCH_LOOKIN}
$L{BSCH_TYPEOFPAGE}

EOFORM print ""; # print "\n"; print "

\n"; &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } ######################################################################### # WHERE DOES THIS SEARCH TAKE PLACE? $w = $FORM{'searchwhere'}; undef @topics; undef %secured; undef %searcht; foreach $topic (split(/,/, $w)) { $searcht{$topic} = 1; } open (TOPICS, "$message_dir/$board_topics_file"); @tf = ; close (TOPICS); @tf2 = grep(/|) { $topic = $1; next if ($searcht{$topic} != 1 && $w ne "ALL"); if (-e "$message_dir/$topic") { $secured{$topic} = 0; push (@topics, $topic); } else { $secured{$topic} = 1; @auth = &ex('validate_auths', $topic); if (grep(/^$topic$/, @auth)) { push (@topics, $topic); } } } } ######################################################################### # READ IN THE TREE DATA $tmp = $/; undef $/; foreach $topic (@topics) { open (TREE, "$admin_dir/msg_index/$topic-tree.txt"); $TT{$topic} = ; close (TREE); } $/ = $tmp; open (TREE, "$admin_dir/tree.txt"); @tree = ; close (TREE); foreach $line (@tree) { @c = split(/\t/, $line); if ($TT{$c[1]} ne "") { $line = $TT{$c[1]}; } else { $line = ""; } } @TREE_STRUCTURE_FILE = split(/\n/, join("", @tree)); ######################################################################### # SEARCH BY KEY WORD, LOOKING IN POSTS if ($FORM{'lookin'} == 0 || $FORM{'lookin'} == 3) { if ($FORM{'tempfile'} ne "") { $tempfile = $FORM{'tempfile'}; $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; } else { $fulltempfile = ""; } if (-f "$admin_dir/msg_index/searches") { unlink("$admin_dir/msg_index/searches"); } if (!-d "$admin_dir/msg_index/searches") { mkdir("$admin_dir/msg_index/searches", oct($perms0777)) || &error_message("Directory Error", "Could not create 'searches' subdirectory. This is probably a permissions problem. Make sure that the 'msg_index' subdirectory is world writable."); chmod(oct($perms0777), "$admin_dir/msg_index/searches"); } undef @t_in_order; if ($fulltempfile eq "" || !-e $fulltempfile) { $tempfile = join("", time, $$); $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; $q = $FORM{'query'}; $w = $FORM{'searchwhere'}; $l = $FORM{'lookin'}; $y = $FORM{'typepage'}; open (TEMP, ">$fulltempfile"); print TEMP $q, "\n"; print TEMP $w, "\n"; print TEMP $l, "\n"; print TEMP $y, "\n"; print TEMP $ENV{'REMOTE_ADDR'}, "\n"; print TEMP "\n"; close (TEMP); $qm = &parse_in($q, 3); foreach $word (@required) { $wordscores{$word} = 0; } foreach $word (@optional) { $wordscores{$word} = 0; } foreach $word (@forbidden) { $wordscores{$word} = 0; } undef %scores; undef %wordscores; undef %reqscore; undef %pgscore; undef %strikes; X: foreach $num (@topics) { if (open(INDEX, "$admin_dir/msg_index/$num-search.txt")) { OUT: while ($mm = ) { chomp $mm; ($post, $topic, $page, $text) = split(/\s/, $mm, 4); next OUT if $strikes{"$topic/$page"} == 1; IN1: foreach $forb (@forbidden) { if ($text =~ m|$forb|i) { $wordscores{$forb} += 1; $strikes{"$topic/$page"} = 1; delete $scores{"$topic/$page"}; next OUT; } } IN2: foreach $req (@required) { if ($text =~ m|$req|i) { $x = length($req); while ($mm =~ m|$req|ig) { $wordscores{$req} += 1; $x *= 1.3; } $reqscore{"$topic/$page"} .= "|||$req|||"; $scores{"$topic/$page"} += $x; $pgscore{"$topic/$page"} .= "\t$req\t" if $pgscore{"$topic/$page"} !~ m|\t$req\t|; } } IN3: foreach $opt (@optional) { if ($text =~ m|$opt|i) { $x = length($opt); while ($text =~ m|$opt|ig) { $x *= 1.1; $wordscores{"$opt"} += 1; } $scores{"$topic/$page"} += $x; $pgscore{"$topic/$page"} .= "\t$opt\t" if $pgscore{"$topic/$page"} !~ m|\t$opt\t|; } } } close (INDEX); } } foreach $key (keys(%scores)) { $ct = ($pgscore{$key} =~ s/\t//g); $scores{$key} = $scores{$key} * ((1.5*length($pgscore{$key}))**2); } open (TEMPFILE, ">>$fulltempfile"); foreach $key (sort(keys(%wordscores))) { print TEMPFILE "$key $wordscores{$key}\n"; } $comments = ""; print TEMPFILE "\n"; foreach $key (reverse(sort by_score keys(%scores))) { next if $scores{$key} == 0; foreach $req (@required) { $req2 = quotemeta($req); if ($reqscore{$key} !~ m%\|\|\|$req2\|\|\|%i) { $scores{$key} = ""; delete $scores{$key}; } } print TEMPFILE "$key $scores{$key}\n" if $scores{$key} != 0; push (@t_in_order, $key) if $scores{$key} != 0; } print TEMPFILE "\n"; print TEMPFILE "Comments section:\n"; print TEMPFILE "Required Words: ", join(",", @required), "\n"; print TEMPFILE "Optional Words: ", join(",", @optional), "\n"; print TEMPFILE "Forbidden Words: ", join(",", @forbidden), "\n"; print TEMPFILE "Ignored Words: ", join(",", @omit), "\n"; close (TEMPFILE); } else { open (TEMPFILE, $fulltempfile) || &error_message("Result Expired", "You cannot use this search result, as it has expired from the server.") if $a ne $ENV{'REMOTE_ADDR'}; @tempfile = ; close (TEMPFILE); ($q) = shift(@tempfile); chomp $q; ($w) = shift(@tempfile); chomp $w; ($l) = shift(@tempfile); chomp $l; ($y) = shift(@tempfile); chomp $y; ($a) = shift(@tempfile); chomp $a; $qm = &parse_in($q); &error_message("Result Expired", "You cannot use this search result, as it was created from a different machine.", 0, 1) if $a ne $ENV{'REMOTE_ADDR'}; shift (@tempfile); $flag = 0; foreach $line (@tempfile) { chomp $line; if ($line !~ m|\S|) { $flag = 2 if $flag == 1; $flag = 1 if $flag == 0; } elsif ($flag == 0) { ($word, $count) = split(/\s/, $line); $wordscores{$word} = $count; } elsif ($flag == 1) { ($page, $count) = split(/\s/, $line); $scores{$page} = $count; push (@t_in_order, $page); } } } &header; &ex('printuntil', 1, 1, 0, "$L{BSCHRESULTS}"); print "
$L{BSCHRESULTS}
\n"; $pages = scalar(@t_in_order); if ($pages == 0) { $reply = $L{BSCH_0HITS}; } elsif ($pages == 1) { $reply = $L{BSCH_1HIT}; } else { $reply = $L{BSCH_MANYHITS}; } $qq = &remove_html($q); $reply =~ s/\%query/$qq/g; $reply =~ s/\%results/$pages/g; print $reply; if (scalar(@omit)) { print "
$L{KEYWORD_IGNORED} "; print join(",", @omit), "\n"; } if ($pages == 0) { &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } print "
\n"; $sn = 1 + (10 * $FORM{'sn'}); if ($sn > $pages || $sn < 1) { $sn = 1; } $ctrqqq = 0; @wx = @required; push (@wx, @optional); foreach $k (@t_in_order) { $ctrqqq += 1; last if $ctrqqq >= (10+$sn); next if $ctrqqq < $sn; print "$ctrqqq. "; ($t, $p) = split(/\//, $k); ($x) = grep(/^(\d+)\t$t\t$p\t/, @TREE_STRUCTURE_FILE); @c = split(/\t/, $x); ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($t, $p); undef $navstr; $head =~ m||; $navstr = "$2"; $i = 0; $flag = 0; while ($flag == 0) { $i += 1; if ($head =~ m||) { $navstr .= ": $2"; } else { $flag = 1; } } if (-e "$message_dir/$t") { $url = "$message_url/$t/$p.$ext"; $url .= "?$lm" if !$noqm; } else { $url = "$script_url/board-auth.$cgi_extension?file=/$t/$p.$ext"; } print "$navstr
\n"; @msg = split(/\n/, $message); $CTR = 0; $flag = 0; foreach $line (@msg) { next if $CTR > 5; if ($line =~ m|(.*)|) { $text = &remove_html($1); foreach $word (@wx) { if ($text =~ m|$word|i) { $b = " $`"; $a = "$' "; $m = $&; $b =~ m|\s(.{0,30})$|; $ob = $1; $a =~ m|^(.{0,30})|; $oa = $1; $text = $'; $str = join("", $ob, $m, $oa); $str = &remove_html($str); $str =~ s%<%<%g; $str =~ s%>%>%g; $str =~ s%($word)%$1%ig if $flag; print "      $L{BSCH_DOT} $str
\n"; $CTR += 1; } } } elsif ($line =~ m||) { $flag = $1; } } print "

\n"; } &print_bottom(3, scalar(@t_in_order)); } ######################################################################### # SEARCH BY AUTHOR'S NAME if ($FORM{'lookin'} == 2) { undef %rs; undef @t_in_order; if ($FORM{'tempfile'} ne "") { $tempfile = $FORM{'tempfile'}; $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; } else { $fulltempfile = ""; } if (!-e "$admin_dir/msg_index/searches") { mkdir("$admin_dir/msg_index/searches", oct($perms0777)) || &error_message("Directory Error", "Could not create 'searches' subdirectory. This is probably a permissions problem. Make sure that the 'msg_index' subdirectory is world writable."); chmod(oct($perms0777), "$admin_dir/msg_index/searches"); } if ($fulltempfile eq "" || !-e $fulltempfile) { $tempfile = join("", time, $$); $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; $q = $FORM{'query'}; $w = $FORM{'searchwhere'}; $l = $FORM{'lookin'}; $y = $FORM{'typepage'}; open (TEMP, ">$fulltempfile"); print TEMP $q, "\n"; print TEMP $w, "\n"; print TEMP $l, "\n"; print TEMP $y, "\n"; print TEMP $ENV{'REMOTE_ADDR'}, "\n"; print TEMP "\n"; close (TEMP); $qm = &parse_in($q); O1: foreach $topic (@topics) { open (LOG, "$admin_dir/msg_index/$topic-log.txt"); O2: while () { @c = split(/;/, $_); $y = &unescape($c[7]); chomp $y; I1: foreach $line (@forbidden) { next O2 if $y =~ m|$line|i; } I2: foreach $line (@required) { next O2 if $y !~ m|$line|i; } I3: foreach $line (@required) { $rs{$c[3]} .= "$y|[$c[0]]($c[6])|||" if $y =~ m|$line|i; } I4: foreach $line (@optional) { $rs{$c[3]} .= "$y|[$c[0]]($c[6])|||" if $y =~ m|$line|i; } } close (LOG); } open (TEMP, ">>$fulltempfile"); @rs = reverse(sort by_rs keys(%rs)); foreach $key (@rs) { print TEMP "$key $rs{$key}\n"; push (@t_in_order, "$key $rs{$key}"); } close (TEMP); } else { open (TEMPFILE, $fulltempfile) || &error_message("Result Expired", "You cannot use this search result, as it has expired from the server.") if $a ne $ENV{'REMOTE_ADDR'}; @tempfile = ; close (TEMPFILE); ($q) = shift(@tempfile); chomp $q; ($w) = shift(@tempfile); chomp $w; ($l) = shift(@tempfile); chomp $l; ($y) = shift(@tempfile); chomp $y; ($a) = shift(@tempfile); chomp $a; $qm = &parse_in($q); &error_message("Result Expired", "You cannot use this search result, as it was created from a different machine.", 0, 1) if $a ne $ENV{'REMOTE_ADDR'}; shift (@tempfile); $flag = 0; foreach $line (@tempfile) { chomp $line; if ($line !~ m|\S|) { $flag = 2 if $flag == 1; $flag = 1 if $flag == 0; } elsif ($flag == 0) { ($page, $count) = split(/\s/, $line, 2); $rs{$page} = $count; push (@rs, $page); } } } &header; &ex('printuntil', 1, 1, 0, "$L{BSCHRESULTS}"); print "

$L{BSCHRESULTS}
\n"; $pages = scalar(keys(%rs)); if ($pages == 0) { $reply = $L{BSCH_0HITS}; } elsif ($pages == 1) { $reply = $L{BSCH_1HIT}; } else { $reply = $L{BSCH_MANYHITS}; } $reply =~ s/\%query/$q/g; $reply =~ s/\%results/$pages/g; print $reply; if ($pages == 0) { &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } print "
\n"; $sn = 1 + (10 * $FORM{'sn'}); if ($sn > $pages || $sn < 1) { $sn = 1; } $tmp = $/; undef %TT; foreach $topic (@topics) { open (TOPIC, "$admin_dir/msg_index/$topic-tree.txt"); $TT{$topic} = ; close (TOPIC); } $ctrqqq = 0; foreach $k (@rs) { $ctrqqq += 1; last if $ctrqqq >= (10+$sn); next if $ctrqqq < $sn; print "$ctrqqq. "; ($t, $p) = split(/\//, $k); ($x) = grep(/^(\d+)\t$t\t$p\t/, @TREE_STRUCTURE_FILE); @c = split(/\t/, $x); ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($t, $p); undef $navstr; $head =~ m||; $navstr = "$2"; $i = 0; $flag = 0; while ($flag == 0) { $i += 1; if ($head =~ m||) { $navstr .= ": $2"; } else { $flag = 1; } } if (-e "$message_dir/$t") { $url = "$message_url/$t/$p.$ext"; $url .= "?$lm" if !$noqm; } else { $url = "$script_url/board-auth.$cgi_extension?file=/$t/$p.$ext"; } print "$navstr
\n"; @m = split(/\|\|\|/, $rs{$k}); for ($CTR = 0; $CTR <= 5; $CTR++) { if ($m[$CTR] ne "") { if ($m[$CTR] =~ m%^(.*)\|\[(\d+)\]\(([^\)]+)\)$%) { ($v1, $v2, $v3) = ($1, $2, $3); $str = &unescape($v3); $str = &remove_html($str); $str =~ s%<%<%g; $str =~ s%>%>%g; print "      "; print "$L{BSCH_DOT} $v1 -- $str
\n"; } } } print "

\n"; } &print_bottom(2, scalar(@rs)); } ######################################################################### # SEARCH BY PAGE TITLE if ($FORM{'lookin'} == 1) { undef %rs; undef @t_in_order; if ($FORM{'tempfile'} ne "") { $tempfile = $FORM{'tempfile'}; $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; } else { $fulltempfile = ""; } if (!-e "$admin_dir/msg_index/searches") { mkdir("$admin_dir/msg_index/searches", oct($perms0777)) || &error_message("Directory Error", "Could not create 'searches' subdirectory. This is probably a permissions problem. Make sure that the 'msg_index' subdirectory is world writable."); chmod(oct($perms0777), "$admin_dir/msg_index/searches"); } if ($fulltempfile eq "" || !-e $fulltempfile) { $tempfile = join("", time, $$); $tempfile =~ s/\D//g; $fulltempfile = "$admin_dir/msg_index/searches/$tempfile.txt"; $q = $FORM{'query'}; $w = $FORM{'searchwhere'}; $l = $FORM{'lookin'}; $y = $FORM{'typepage'}; open (TEMP, ">$fulltempfile"); print TEMP $q, "\n"; print TEMP $w, "\n"; print TEMP $l, "\n"; print TEMP $y, "\n"; print TEMP $ENV{'REMOTE_ADDR'}, "\n"; print TEMP "\n"; close (TEMP); $qm = &parse_in($q); $tmp = $/; O2a: foreach $z (@TREE_STRUCTURE_FILE) { @c = split(/\t/, $z); $c1 = $c[1]; next O2a if $c[5] !~ m|Messages| && $FORM{typepage} == 1; next if !grep(/^$c1$/, @topics); $y = &unescape($c[4]); I1a: foreach $line (@forbidden) { next O2a if $y =~ m|$line|i; } I2a: foreach $line (@required) { next O2a if $y !~ m|$line|i; } I3a: foreach $line (@required) { $rs{"$c[1]/$c[2]"} += 1 if $y =~ m|$line|i; } I4a: foreach $line (@optional) { $rs{"$c[1]/$c[2]"} += 1 if $y =~ m|$line|i; } } open (TEMP, ">>$fulltempfile"); @rs = reverse(sort by_rs2 keys(%rs)); foreach $key (@rs) { print TEMP "$key $rs{$key}\n"; push (@t_in_order, "$key $rs{$key}"); } close (TEMP); } else { open (TEMPFILE, $fulltempfile) || &error_message("Result Expired", "You cannot use this search result, as it has expired from the server.") if $a ne $ENV{'REMOTE_ADDR'}; @tempfile = ; close (TEMPFILE); ($q) = shift(@tempfile); chomp $q; ($w) = shift(@tempfile); chomp $w; ($l) = shift(@tempfile); chomp $l; ($y) = shift(@tempfile); chomp $y; ($a) = shift(@tempfile); chomp $a; $qm = &parse_in($q); &error_message("Result Expired", "You cannot use this search result, as it was created from a different machine.", 0, 1) if $a ne $ENV{'REMOTE_ADDR'}; shift (@tempfile); $flag = 0; foreach $line (@tempfile) { chomp $line; if ($line !~ m|\S|) { $flag = 2 if $flag == 1; $flag = 1 if $flag == 0; } elsif ($flag == 0) { ($page, $count) = split(/\s/, $line, 2); $rs{$page} = $count; push (@rs, $page); } } } &header; &ex('printuntil', 1, 1, 0, "$L{BSCHRESULTS}"); print "

$L{BSCHRESULTS}
\n"; $pages = scalar(keys(%rs)); if ($pages == 0) { $reply = $L{BSCH_0HITS}; } elsif ($pages == 1) { $reply = $L{BSCH_1HIT}; } else { $reply = $L{BSCH_MANYHITS}; } $qq = &remove_html($q); $reply =~ s/\%query/$qq/g; $reply =~ s/\%results/$pages/g; print $reply; if ($pages == 0) { &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } print "
\n"; $sn = 1 + (10 * $FORM{'sn'}); if ($sn > $pages || $sn < 1) { $sn = 1; } $ctrqqq = 0; foreach $k (@rs) { $ctrqqq += 1; last if $ctrqqq >= (10+$sn); next if $ctrqqq < $sn; print "$ctrqqq. "; ($t, $p) = split(/\//, $k); ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($t, $p); undef $navstr; $head =~ m||; $navstr = "$2"; $i = 0; $flag = 0; while ($flag == 0) { $i += 1; if ($head =~ m||) { $navstr .= ": $2"; } else { $flag = 1; } } if (-e "$message_dir/$t") { $url = "$message_url/$t/$p.$ext"; $url .= "?$lm" if !$noqm; } else { $url = "$script_url/board-auth.$cgi_extension?file=/$t/$p.$ext"; } print "$navstr\n"; print "

\n"; } &print_bottom(1, scalar(@rs)); } if ($FORM{'lookin'} < 0 || $FORM{'lookin'} > 3 || $FORM{'lookin'} != int($FORM{'lookin'})) { &error_message("Keyword Search Error", "The form variable 'lookin' must be between 0-3!", 0, 1); } ######################################################################### # GENERAL SUBROUTINES sub by_rs { $ac = $rs{$a}; $s = ($ac =~ s/\|\|\|//g); $ac = $s; $bc = $rs{$b}; $s = ($bc =~ s/\|\|\|//g); $bc = $s; return ($ac <=> $bc); } sub by_rs2 { return 1 if $rs{$a} gt $rs{$b}; return -1 if $rs{$a} lt $rs{$b}; } sub by_score { $scores{$a} <=> $scores{$b}; } sub parse_in { undef @required; undef @forbidden; undef @optional; my ($qm, $param) = @_; if ($FORM{'boolean'} eq "and") { @wordsx = split(/\s+/, $qm); foreach $w (@wordsx) { if ($w !~ m|^[\-\+]|) { $w = "+$w"; } } $qm = join(" ", @wordsx); } while ($qm =~ m|([\-\+])\s*"([^"]*)"|) { $sign = $1; $phrase = $2; $af = $'; $bf = $`; $phrase =~ s/^\s+//; $phrase =~ s/\s+$//; $phrase =~ s/\s+/ /g; push (@required, &char_convert($phrase)) if $sign eq "+"; push (@forbidden, &char_convert($phrase)) if $sign eq "-"; $qm = join("", $bf, $af); } while ($qm =~ m|"([^"]*)"|) { $phrase = $1; $af = $'; $bf = $`; $phrase =~ s/^\s+//; $phrase =~ s/\s+$//; $phrase =~ s/\s+/ /g; push (@optional, &char_convert($phrase)); $qm = join("", $bf, $af); } while ($qm =~ m|([\-\+])\s*(\S+)|) { $sign = $1; $phrase = $2; $af = $'; $bf = $`; $phrase =~ s/^\s+//; $phrase =~ s/\s+$//; $phrase =~ s/\s+/ /g; push (@required, &char_convert($phrase)) if $sign eq "+"; push (@forbidden, &char_convert($phrase)) if $sign eq "-"; $qm = join("", $bf, $af); } while ($qm =~ m|(\S+)|) { $phrase = $1; $af = $'; $bf = $`; $phrase =~ s/^\s+//; $phrase =~ s/\s+$//; $phrase =~ s/\s+/ /g; push (@optional, &char_convert($phrase)); $qm = join("", $bf, $af); } undef @omit; if ($param == 3) { foreach $line (@required) { ($x, $y) = &ex('search_stop', $line, 1); push (@omit, $y); $line = quotemeta($x); } foreach $line (@forbidden) { ($x, $y) = &ex('search_stop', $line, 1); push (@omit, $y); $line = quotemeta($x); } foreach $line (@optional) { ($x, $y) = &ex('search_stop', $line, 1); push (@omit, $y); $line = quotemeta($x); } } else { foreach $line (@required) { $line = quotemeta($line); } foreach $line (@forbidden) { $line = quotemeta($line); } foreach $line (@optional) { $line = quotemeta($line); } } if ($FORM{'matchtype'} eq "wholeword") { foreach $word (@required) { $word = "\\b$word\\b"; } foreach $word (@optional) { $word = "\\b$word\\b"; } foreach $word (@forbidden) { $word = "\\b$word\\b"; } } @required = grep(/\S/, @required); @optional = grep(/\S/, @optional); @forbidden = grep(/\S/, @forbidden); @omit = grep(/\S/, @omit); } sub print_bottom { my ($param, $t) = @_; print "$L{KEYWORD_RESULTS_PAGES} "; if ($FORM{'sn'} == 0) { print $L{KEYWORD_RESULTS_PREV}; } else { print "$L{KEYWORD_RESULTS_PREV}"; } print " "; $ctr = -1; $flag = 0; $lf = 0; $sn = $FORM{'sn'}; while ($flag == 0) { $ctr += 1; $sn_x = 1 + (10*$ctr); last if $sn_x > $t; if ($ctr != $sn) { print "", (1+$ctr), " "; $lf = 0; } elsif ($ctr == $sn) { print "", (1+$ctr), " "; $lf = 1; } } if (!$lf) { print "$L{KEYWORD_RESULTS_NEXT}"; } else { print $L{KEYWORD_RESULTS_NEXT}; } if ($param == 3) { print "
\n"; print $L{KEYWORD_WORDCOUNT}, "\n"; undef @r; foreach $key (sort(keys(%wordscores))) { $key2 = $key; $key2 =~ s/\\b//g; $key2 =~ s/\\\s+/ /g; $key2 =~ s/\\\\/\/g; $key2 =~ s/\\//g; push (@r, "$key2: $wordscores{$key}"); } $r = join(", ", @r); print $r; print "\n"; } &ex('printuntil', 3, 17, 0, "", 0, 1); exit(0); } # END - FILE IS CORRECTLY UPLOADED #