#!/usr/bin/perl

# Web-Search Script Copyright 1996 Version 2.0

# ISPs and Web Designers Contact Web Search about licensing agreements

# Huge discounts for creating customer search engines

# Email webmaster@web-search.com
# This is UNPUBLISHED PROPRIETARY SOURCE CODE of Web-Search.Com Inc 
# Web-Search Contents and Software Copyright November 1996 
# The contents of this file may not be disclosed to third
# parties, copied or duplicated in any form, in whole or in part,
# without the prior written permission of Web-Search.Com Inc..
# 
# Permission is hereby granted soley to the licensee for use of this
# source code in its unaltered state. This source code may not be
# modified by licensee except under direction of Web-Search.Com Inc.
# either may this source code be given under any circumstances to
# non-licensees in any form, including source or binary. Modification
# of this source constitutes breach of contract, which voids any
# potential pending support responsibilities by Web-Search.Com Inc.. Divulging
$personalid = 'clay';
# the exact or paraphrased contents of this source code
# to unlicensed parties either directly or indirectly constitutes violation of federal
# and international copyright and trade secret laws, and will be duly
# prosecuted to the fullest extent permitted under law.
#
# THIS SOFTWARE IS PROVIDED BY WEB-SEARCH.COM INC. ``AS IS'' AND ANY EXPRESS
# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABLILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 
# Complete, Authorized versions of Web Search may be obtained at
# http://www.web-search.com/websoft.html
#             

$thisfile = $0;
$thisfile =~ s#.*/(.*)#$1#;



$data = "$thisfile.txt";              


# undocumented feature:
# if there's only one line in the file, turn it into the pathname...
open(DATA,"$data")||die;
$line = <DATA>;
$line2 = <DATA>;
close(DATA);
chop($line);
$data = $line unless ($line2 =~ /\t/);

&parse;

die unless ($in{'1sp-license'} eq $personalid);

&prep;
@heads = split(/\t/,$heads);
&printheader;
if($way){
    &makeprinteval;
    &makeeval;
    &process;
} else {
    print "<h3>No query was entered.</h3>\n";
}
&printfooter;

###
### Subs
###

sub prep {

    while(($key,$value) = (each %in)){

# these are the four lines I dearly want to lose:
        &sorry if ($value =~ /[\"\`\;]/);
        &sorry if ($value =~ /EOT/);
        &sorry if ($key =~ /[\"\`\;]/);
        &sorry if ($key =~ /EOT/);
        next unless ($value);
        if($key =~ s/^override([A-Za-z]+)([A-Za-z0-9]*)$/$1$2/i){
            $two = "comp$2";
            $_ = $value; 
            ($three,$four) = /^([A-Za-z]+)([A-Za-z0-9]*)$/;
	    $four = "comp$four";
            $in{"$value"} = $in{$key};
            $in{"$four"} = $in{"$two"};
#	    print STDERR "$four: $in{$four} $two: $in{$two}\n";
	    $over = "override$key";
            delete($in{$key}) unless ($key eq $value);
# why is this necessary? without it there's two overridecol1, which I don't understand:
            delete($in{$over}) unless ($key eq $value);

         }
    }

    while(($key,$value) = (each %in)){
#            print STDERR "$key $value\n";
        next unless ($value);
#        $ps = "hmm" if ($key =~ /^\d[ps]{2}/);
        if($key =~ /^([A-Za-z]+)([0-9]+[A-Za-z0-9]*)$/){
            $one = $1;  $two = $2;

            if($one =~ /^col$/){
                if($in{"comp$two"} =~ /all/i){
                    $value =~ s/ and / /ig;
                    $value =~ s/ or / /ig;
                    $value =~ s#\s+# and #g;
		} elsif($in{"comp$two"} =~ /any/i){
                    $value =~ s/ and / /ig;
                    $value =~ s/ or / /ig;
                    $value =~ s#\s+# or #g;
		}
            }

            if($in{"comp$two"} =~ /all/i){
                $andor =  "and";
            } else { 
                $andor =  "or";
            }

            $value =~ s/\\0/ $andor /g;
            $eval = '$'."$one"."[$two] = \"$value\"";
            eval $eval;
        }
        if($key =~ /^col\d+[A-Za-z0-9]*$/i){
            $multi{"$key"} = $value;
            $way = 1;
        }
     }

    $all = $in{'all'};
    $way =1 if ($all);

    $allcomp = $in{'allcomp'};
    $comp = $in{'comp'};

    if($all){
        if($allcomp =~ /all/i){
            $all =~ s/ and / /ig;
            $all =~ s/ or / /ig;
            $all =~ s/\s+/ and /g;
            $all =~ s/\\0/ and /g;
        } elsif($allcomp =~ /any/i){
            $all =~ s/ and / /ig;
            $all =~ s/ or / /ig;
            $all =~ s/\s+/ or /g;
            $all =~ s/\\0/ or /g;
        } else {
            $all =~ s/\\0/ or /g;
        }
    }

#    $in{'number'} = 20 unless ($in{'number'});
    $in{'startnum'} = 1 unless ($in{'startnum'});

    $title = $in{'title'};

    $number = $in{'number'} || 20;
    $startnum = $in{'startnum'};

    $counter = 0;
    $stopnum = ($startnum + $number)-1;

    $sort = $in{'sort'};
    $_ = $sort;
    ($sortcol,$sortby) = (/col(\d+)(.*)/i);

    if ($sort =~ /^random$/i){
        $sortcol = 1; $sortby = "random";
    }

    $snap = $in{'snap'};
    $snap =~ tr/a-z/A-Z/;

    open(DATA,"$data");
    $heads = <DATA>;
    chop($heads);

    if(($snap eq "UL") || ($snap eq "OL")){
        $top = $in{'top'} || "<$snap>";
        $begin = $in{'begin'} || "<LI>";
        $middle = $in{'middle'};
        $wrapon = $in{'wrapon'} || "none";
        $wrapoff = $in{'wrapoff'} || " ";
        $end = $in{'end'} || "none";
        $bottom = $in{'bottom'} || "</$snap>";
    } elsif($snap eq "DL"){
        $top = $in{'top'} || "<DL>";
        $begin = $in{'begin'} || "<DT>";
        $middle = $in{'middle'} || "<DD>";
        $wrapon = $in{'wrapon'} || "none";
        $wrapoff = $in{'wrapoff'} || " ";
        $end = $in{'end'} || "none";
        $bottom = $in{'bottom'} || "</DL>";
    } elsif ($snap eq "NONE") {
        $top = $in{'top'};
        $begin = $in{'begin'};
        $middle = $in{'middle'};
        $wrapon = $in{'wrapon'};
        $wrapoff = $in{'wrapoff'};
        $end = $in{'end'};
        $bottom = $in{'bottom'};
    } else {
        $snap = "TABLE";
        $top = $in{'top'} || "<TABLE>";
        $begin = $in{'begin'} || "<TR>";
        $middle = $in{'middle'};
        $wrapon = $in{'wrapon'} || "<TD VALIGN=top>";
        $wrapoff = $in{'wrapoff'} || "</TD>";
        $end = $in{'end'} || "</TR>";
        $bottom = $in{'bottom'} || "</TABLE>";
    }

    $headerwrapon = $in{'headerwrapon'} || "<b>";
    if($snap eq "TABLE"){
        $headerwrapoff = $in{'headerwrapoff'} || "</b> ";
    } else {
        $headerwrapoff = $in{'headerwrapoff'} || ":</b> ";
    } 
    $top = "" if ($top =~ /^none$/i);
    $begin = "" if ($begin =~ /^none$/i);
    $middle = "" if ($middle =~ /^none$/i);
    $wrapon = "" if ($wrapon =~ /^none$/i);
    $wrapoff = "" if ($wrapoff =~ /^none$/i);
    $end = "" if ($end =~ /^none$/i);
    $bottom = "" if ($bottom =~ /^none$/i);

    $match = $in{'match'};

}

sub process {
    
#    print "<PRE>";
#    print $comp;
#    print $eval;
#    print "</PRE>";
    eval $eval;
    print "sub process: $@ <BR>\n" if ($@);

# types of sorting:
# "num" (numerical) or default, stirng (case insens???)
# "rev" (reversed)
# or "random" by itself (no col, no sortcol, no sortby)

$sortingphrase = <<"EOT";
    if(\$sortcol) {
        if(\$sortby =~ /num/i) {
            \@rightorder = sort by_number keys(%sort);
        } elsif (\$sort =~ /^random\$/i){
	    srand;
            \@rightorder = sort by_rand keys(%sort);

        } else {
            \@rightorder = sort keys(%sort);
        }

        if (\$sortby =~ /rev/i) {
            \@rightorder = reverse (\@rightorder);
        }

	foreach (\@rightorder) {
EOT

    if(($number) && ($sort)){
        $unless = "if (\$counter >= \$startnum)";
        $sortingphrase .= "\$counter++;\n";
        $sortingphrase .= "((\$notall = 1)&&(last)) if (\$counter > \$stopnum);\n"; 
    }

    $sortingphrase .= <<"EOT";
            print "\$sort{\\"\$_\\"}" $unless ;
        } 
    }
EOT

#    print "<PRE>$sortingphrase</PRE>";

    eval $sortingphrase;
print $@ if ($@);


#    print <<"EOT";
#<HR>
#Sort: $sort<BR>
#Sortcol: $sortcol<BR>
#Sortby: |$sortby|<BR>
#Match: |$match|
#EOT

}

sub makeprinteval {

# every print needs this beginning section:
    if($sortcol){
        $command = "\$rr = int(rand(1)*100000);\n";
        $command .= "\$rr = \"\$rr\"\.\"00000\";\n";
        $command .= "\$rr =~ s#(.....).*#\$1#;\n";
        $command .= "\$thing = \"\$seg[$sortcol]\$rr\";\n";
	$command .= "        \$sort{\"\$thing\"} .= ";
    } else {

        $command = "print ";
    }

    $begin =~ s#(\W)#\\$1#g;
    $middle =~ s#(\W)#\\$1#g;
    $end =~ s#(\W)#\\$1#g;

    $printer = "$begin";

# now add the parts for each header:

    $count = "1";
    $length = @heads;
    $wrapon =~ s#(\W)#\\$1#g;
    $wrapoff =~ s#(\W)#\\$1#g;
    $headerwrapon =~ s#(\W)#\\$1#g;
    $headerwrapoff =~ s#(\W)#\\$1#g;
    foreach $head (@heads) {
        if ($head) {
            $head =~ s#(\W)#\\$1#g;
            if($wrapon){
		$printer .= "$wrapon";

            }
            unless(($snap eq "TABLE") || ($head =~ /^nohead$/i)){
                if ($headerwrapon){
                    $printer .= "$headerwrapon";
                }
                $printer .= "$head";

                if ($headerwrapoff){
                    $printer .= "$headerwrapoff";
                }
	    }

            if ($wrapon[$count]){
                $wrapon[$count] =~ s#(\W)#\\$1#g;
                $printer .= "$wrapon[$count]";
            }
            if($link[$count]){
		$x = $protocol[$count] || "";
                $x =~ s#(\W)#\\$1#g;
                $link[$count] =~ s#(\W)#\\$1#g;
                $printer .= "<A HREF=\\\"$x\$seg[\$link[$count]]\\\">";
            }

            $printer .= "\$seg[$count]";

            if($link[$count]){
                $printer .= "</A>";
            }

	    if($wrapoff[$count]){
                $wrapoff[$count] =~ s#(\W)#\\$1#g;
                $printer .= "$wrapoff[$count]";
            }

	    if($wrapoff){
                $printer .= "$wrapoff";
            }
       }
       $count++;
       if($count == 2){
           $printer .= "$middle";
       }
    }
    $printer .= "$end\n";

#        print "<PRE>\n";
#       print "$command ";
#       print $printer;
#        print "</PRE>\n";
#	print "\n\n";

}

sub makeeval {

    $eval = $count = "";
    $eval = <<"EOT";

    OUTER: while(<DATA>){
        chop; 
        \@seg = split(/\t/);
        unshift(\@seg,"");
        INNER: while(1){
EOT


    if($match =~ /^any$/i){
        $last = "last INNER if";
    } else {
        $last = "next OUTER unless";
    }


    $count = "0";
#    unshift(@col,"");

$yak{'lt'} = "<";
$yak{'lteq'} = "<=";
$yak{'gt'} = ">";
$yak{'gteq'} = ">=";
$yak{'eq'} = "==";

#print STDERR @col;
#print STDERR "\n";

while(($key,$value) = each(%multi)){
    $value =~ s#([^A-Z^a-z^0-9^\*])#\\$1#g;
    $value =~ s#(.*)\*(.*)#$1\\w*$2#g;
    $multi{$key} = $value;
}
$all =~ s#([^A-Z^a-z^0-9^\*])#\\$1#g;
$all =~ s#(.*)\*(.*)#$1\\w*$2#g;

    if($all){
        if($allcomp){
    	    $case = "i" unless ($allcomp =~ /cm/i);
            $w = "\\b" if($allcomp =~ /ww/i);
        } else {
	    $case = "i" unless ($comp =~ /cm/i);
            $w = "\\b" if($comp =~ /ww/i);
        }

        $_ = $all;
        while(s#(.*\w)[\\\s]+or[\\\s]+(.*)#$1$w|$w$2#i){1;}
 
        foreach (split(/[\\\s]+and[\\\s]+/)){
            $blah = "(/$w$_$w/"."$case)";
            push(@dong,$blah);
        }
        $_ = join('&&',@dong);
        $_ = "($_)" if (/\&\&/);
    
        $blahphrase .= "($_) ||";
        
        $blahphrase =~ s#(.*) [\&\|]+$#$1#;
        $eval .= "            $last ($blahphrase);\n";

	undef($w); undef($blahphrase);
    }

    while(($key,$value) = each(%multi)){
        next unless ($value);
        undef($blahphrase);
        $key =~ s#col(.*)#$1#;
#	print STDERR "Looking at $comp[$key] ($key)\n";
	if($comp[$key] =~ /[tq]+/i){
            if ($col[$key] =~ /^[0-9\.]+$/){
                $eval .= "            $last (\$seg[$key] $yak{$comp[$key]} $col[$key] );\n";
            }
        } else {
# I think these four commented lines can go:
#            if($in{"comp$key"} =~ /all/i){
#                $andor =  '&&';
#            } else { 
                $andor =  '||';
#            }
            @blah = split('col',$key);
            undef($count);
            foreach $num (@blah){
                $allseg .= "\$seg[$num]";
            }

            foreach $num (@blah){
                $count++;
                undef($case);
                undef($w);
                undef(@dong);
                undef($blah);
                if($comp[$num]){
                    $case = "i" unless ($comp[$num] =~ /cm/i);
                    $w = "\\b" if ($comp[$num] =~ /ww/i);
                } elsif ($comp[$key]){
                    $case = "i" unless ($comp[$key] =~ /cm/i);
                    $w = "\\b" if ($comp[$key] =~ /ww/i);
                } else {
                    $case = "i" unless ($comp =~ /cm/i);
                    $w = "\\b" if ($comp =~ /ww/i);
                }

	    }

    	    $_ = $value;
        
        while(s#(.*\w)[\\\s]+or[\\\s]+(.*)#$1$w|$w$2#i){1;}
                foreach (split(/[\\\s]+and[\\\s]+/)){
    	        $blah = "(\"$allseg\" =~ /$w$_$w/"."$case)";
                    push(@dong,$blah);
                }
                $_ = join('&&',@dong);
    	    $_ = "($_)" if (/\&\&/);
    
                $blahphrase .= "($_) $andor";
            }
            $blahphrase =~ s#(.*) [\&\|]+$#$1#;
            $eval .= "            $last ($blahphrase);\n";
    
        
    }

    if(($number) && !($sort)){
        $eval .= "      \$counter++; next OUTER unless (\$counter >= \$startnum);\n";
    }

    if($match =~ /^any$/i){
        $eval .= "            next OUTER;\n          }\n";
    } else {
        $eval .= "            last INNER;\n          }\n";
    }

    if(($number) && !($sort)){
        $eval .= "((\$notall = 1)&&(last)) if (\$counter > \$stopnum);\n"; 
    }
    
    $eval .= "        $command \"$printer\";  \n";
    $eval .= "        \$something = 1;\n";
    $eval .= "   }\n";
    $eval .= "   print '<h3>Your query resulted in no matches</h3>' unless (\$something)\n";

#    print "$eval";
#    print "\n";
}

sub parse {

    local($iii,$key,$val,@iii);

    if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $iii = $ENV{'QUERY_STRING'};
    } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
            $iii .= getc;
        }
    } 

    @iii = split(/&/,$iii);

    foreach (@iii) {

        s/\+/ /g;

        s/%(..)/pack("c",hex($1))/ge;

        ($key,$val) = /^([^\=]+)=(.*)$/;

        if ($in{$key}){
            $in{$key} .= "\\0$val"; 
        } else {
            $in{$key} = $val;
        }
    }

}

 
sub printheader {

    print "Content-type: text/html\n\n";

    if(open(HEAD,"$thisfile.head.txt")){
        if($title){
        while (<HEAD>){
            s/\$title/$title/ig;
            print "$_";
        }
    } else {
        print while (<HEAD>);
    }
    } else {
        print <<"EOT";
<BODY BGCOLOR="ffffff">
EOT
    }
    print "$top\n";
    if($snap eq "TABLE"){
        $tablehead = "<TR>";
        $count = 0;
        foreach $blah (@heads){
            $count++;
            next unless ($blah);
            $ok++;
                $toodle = $headerwrapon[$count] || $headerwrapon;
                $toddle = $headerwrapoff[$count] || $headerwrapoff;
            if ($blah =~ /^nohead$/i){
                $tablehead .= "<td></td>";
    	    } else {
                $tablehead .= "<td>$toodle$blah$toddle</td>";
	    }
        }
        $tablehead .= "</TR>\n";
        $tablehead = "" unless ($ok);
        print $tablehead if ($tablehead);
    }
}

sub printfooter {

    print "$bottom\n";

    if($in{'version'}){
        print <<"EOT";
Web Search Version 2.0, 06/23/97
EOT
    }

    &printnext if (($notall) || ($startnum > 1));  

    if(open(FOOT,"$thisfile.foot.txt")){
        print while (<FOOT>);
    } else {
        print <<"EOT";
<P>
<center>
<font size="2" color="red"><B>Powered by</B></font> <A
HREF="http://www.web-search.com/websoft.html"><font
size="2"><B>Web-Search!</B></font></A>
<BR>
<font size="2"><B><I>Create Your Own Search Engine Today!</I></B></font>
</center>
</body>
</html>
EOT

    }

}

# print "$begin<A HREF=\"\$seg[0]\">\$seg[1]</A>$middle$wrapon$head$wrapoff \$seg[$count] $end\n";

sub by_rand {
    $ran = int(rand(1)*3)-1;
    $ran;
}

sub by_number {
    if ($a < $b) {
        -1;
    } elsif ($a == $b) {
        0;
    } elsif ($a > $b) {
        1;
    }
}

sub printnext {

#    print STDERR "$in\n";

    while(($key,$value) = each(%in)){
        $value =~ s#\s+#%20#g;
        $url .= "$key=$value\&" unless ($key =~ /^startnum$/);
    }

#    $in =~ s/(.*)startnum=\d*(.*)/$1$2/gi;

        print <<"EOT";
<BLOCKQUOTE>
<b>See
EOT

    if($notall){
        $nextnum = ($startnum + $number);
        $url = "$url"."&" unless ($url =~ /&$/);
        $nexturl = "$url"."startnum=$nextnum";

        print <<"EOT";
<A HREF="$thisfile?$nexturl">next set</A>
EOT
}

    print "or " if(($startnum > 1) && ($notall));
    if($startnum > 1){
    $prevnum = $startnum - $number;
    $url = "$url"."&" unless ($url =~ /&$/);
    $prevurl = "$url"."startnum=$prevnum";

        print <<"EOT";
<A HREF="$thisfile?$prevurl">previous set</A>
EOT
    }

    print <<"EOT";
of matches</b>
</BLOCKQUOTE>
EOT
}

sub sorry {

    print <<"EOT";
Content-type: text/html

<BODY BGCOLOR="ffffff">

Sorry--input and tags from the form may not contain semi-colons or
quotes. This may be changed in a later version of Web Search.

</BODY>
EOT

    exit;

}