#!/usr/bin/perl -w

# Phind version 5
# Copyright 2000 Gordon Paynter (gwp@cs.waikato.ac.nz)

use IPC::Open2;

# Set autofulsh (output on newline).
# If you don't then the content-type line gets stuck in the STDOUT
# buffer and written a second time when you call open2 (it uses fork).
$|=1;

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

# Decode arguments

my $options = "";
my $action = "";
my $collection = "";
my $phrase = "";
my $word = "";

my $documentlimit = 10;
my $expansionlimit = 10;

if ($ARGV[0]) { $options = $ARGV[0]; } 
elsif ($ENV{"QUERY_STRING"}) { $options = $ENV{"QUERY_STRING"}; } 
else { $options = "a=help"; }

foreach $pair (split(/&/, $options)) {
    if ($pair =~ /^\w+=.+$/) {
        ($name, $value) = $pair =~ /^(\w+)=(.+)/;
        if ($name =~ /^a/i) { $action = $value; }
        elsif ($name =~ /^c/i) { $collection = $value; }
        elsif ($name =~ /^p/i) { $phrase = $value; }
        elsif ($name =~ /^w/i) { $word = $value; }
        elsif ($name =~ /^d/i) { $documentlimit = $value; }
        elsif ($name =~ /^e/i) { $expansionlimit = $value; }
    }
}



&help if ($action =~ /help/i);
&help unless ($collection);
&help unless ($word || $phrase);

my $gsdlhome = "/research/gsdl";
my $phindhome = "$gsdlhome/src/phind-5/host-5.3";
my $collectdir = "$gsdlhome/collect/$collection";
my $phindexdir = "$collectdir/phindex";


# Suggest a useful phrase in the search form
my $suggestion = "$collection";
$suggestion =~ s/\-.*//;

# Print lists in alternaing colours
my $colour = "#EEFFFF";
my %other;
$other{"#EEFFFF"} = "#FFFFDD";
$other{"#FFFFDD"} = "#EEFFFF";

my $ecolor = "#FFEEEE";

$phrase = &getphrasenumber($word) if ($word);
&query($phrase);




sub query {
    my ($phrase) = @_;

    # Open the mgpp reader
    $hostcommand = "$phindhome/host $phindexdir";
    open2(R, W, "$hostcommand");

    # Perform the query
    print W "$phrase\n";
    my $result = <R>;
    
    my @result = split(/:/, $result);
    shift @result;

    my $base = shift @result;
    my $tf = shift @result;
    my $ef  = shift @result;
    my $exps = shift @result;
    my $df = shift @result;
    my $docs = shift @result;

    $suggestion = $base;
    $suggestion =~ s/ .*//;
    
    print "<html><head><title>$base</title></head>\n<body bgcolor='#FFFFFF'>\n";

    # Start printing the outer table
    print "<center><h1>$base</h1></center>\n<p><table align=center border = 0>
<tr align=center><td>$base occurs $tf times in $df documents.</td></tr>
<tr align=center><td>\n";
    &printform;

    # Print the shorter terms, if avaibale
    if ($base =~ / /) {
	my @words = split(/ +/, $base);
	print "<p>Find: ";

	my $n = 0;
	foreach my $w (@words) {
	    if ($n++) { print " or "; }
	    print " <a href='phind?c=$collection&w=$w'>$w</a>";
	}
    }
    print "</td></tr>\n";

    # Print the expansions
    if ($ef) {

	my @exps = split(/,/, $exps);
	if ($expansionlimit eq "all") {
	    $expansionlimit = $ef;
	}

	print "<tr><td>
<table align=center border=0>
<tr align=center><th colspan = 3>";
	if ($expansionlimit >= $ef) {
	    print "Expansions ($ef)";
	} else {
	    print "Expansions ($expansionlimit of $ef)";
	    splice(@exps, $expansionlimit); 
	}
	print "</th><th>freq</th><th>docs</th></tr>\n";

	foreach my $e (@exps) {
	    print &phraserow($e,$base) . "\n";
	}

	if ($expansionlimit < $ef) {
	    print "<tr align=center bgcolor=$ecolor><td colspan = 5>
<table><tr><td align=center>
<a href='phind?c=$collection&p=$phrase&d=$documentlimit&e=", $expansionlimit + 10, "'>Get more phrases</a></td><td align=center>
<a href='phind?c=$collection&p=$phrase&d=$documentlimit&e=$ef'>Get every phrase</a></td></tr></table>
</td></tr>\n";
	}

	print "</table></tr></td>\n";

    } else {
	print "<tr align=center><th>There are no expansions of this phrase.</th></tr>\n";
    }

    # Print the documents
    my @docs = split(/[;\n]/, $docs);
    if ($documentlimit eq "all") {
	$documentlimit = $df;
    }
    
    print "<tr><td>
<table align=center border=0>
<tr align=center><th>";
    if ($documentlimit >= $df) {
	print "Documents ($df)";
    } else {
	print "Documents ($documentlimit of $df)";
	splice(@docs, $documentlimit); 
    }
    print "</th><th>freq</th></tr>\n";
    
    open(DOCS, "<$phindexdir/mg-d.txt");
    my ($d, $f, $num, $line, $h, $t);
    $num = 0;
    foreach $d (@docs) {

	# get document number and frequency
	$f = 1;
	if ($d =~ /,/) {
	    ($d, $f) = $d =~ /(\d+),(\d+)/
	}

	# read the document file up to this document
	while ($num < $d) {
	    $line = <DOCS>;
#	    print "# $line\n";
	    $num++;
	}

	# get document hash and title
	($h, $t) = $line =~ /^(.*)\t(.*)$/;

	# print the information
	$colour = $other{$colour};
	print "<tr align=center bgcolor='$colour'><td align=left><a href='library?a=d&c=$collection&d=HASH$h'>$t</a></td><td>$f</td></tr>\n";
    }

    if ($documentlimit < $df) {
	print "<tr align=center bgcolor=$ecolor><td colspan = 2>
<table><tr><td align=center>
<a href='phind?c=$collection&p=$phrase&d=", $documentlimit + 10, "&e=$expansionlimit'>Get more documents</a>
</td><td align=center>
<a href='phind?c=$collection&p=$phrase&d=$df&e=$expansionlimit'>Get every document</a>
</td></tr></table>";
    }
 
    print "</table></td></tr>
</table></body></html>
";

    # close the host process
    print W "0\n";

}


sub printform {

    my @collects = ("aircraft", "folktale", "forestry", "forestry-sw", "rutgers", "rutgers-sw", "acrodemo", "acrostop");

    print"<form method='GET' action='phind'>
Find <input name='w' size='20' maxlength='200' value='$suggestion'> 
in <select name=c>
";
    foreach my $c (@collects) {
	print "<option value='$c'";
	print " selected" if ($c eq $collection);
	print ">$c</option>\n";
    }
    print "</select><input type='submit' value='Submit'></form>";
}

sub getphrasenumber {
    my ($word) = @_;

    $phrase = `grep -in ":$word:" $phindexdir/mg-p.txt`;
    $phrase =~ s/:.*//;
    
    &help_word_not_found if ($phrase !~ /\d+/);
    return $phrase;
}


sub phraserow {
    my ($number, $centre) = @_;

    print W "$number\n";
    my $result = <R>;

    my ($text, $tf, $df) = $result =~ /^<Document>\d+:(.*):(\d+):.*:.*:(\d+):.*$/;
    my ($l, $r) = $text =~ /(.*)$centre(.*)/;
    
    $colour = $other{$colour};
    my $row = "<tr align=center valign=top bgcolor='$colour'>";
    if ($l =~ /./) {
	$l =~ s/ *$//;
	$row .= "<td align=right><a href='phind?c=$collection&p=$number'>$l</a></td>";
    } else {
	$row .= "<td>&nbsp;</td>";
    }
    $row .= "<td><a href='phind?c=$collection&p=$number'>$centre</a></td>";
    if ($r =~ /./) {
	$r =~ s/^ *//;
	$row .= "<td align=left><a href='phind?c=$collection&p=$number'>$r</a></td>";
    } else {
	$row .= "<td>&nbsp;</td>";
    }
    $row .= "<td>$tf</td><td>$df</td></tr>";

    return $row;
}

sub help {
    print "<html><head><title>phind</title></head>
<body bgcolor='#FFFFFF'><center><h1>phind</h1><p>
";
    &printform;
    print"</center></body></html>";
    exit(0);
}

sub help_word_not_found {
    print "<html><head><title>phind - word not found</title></head>
<body bgcolor='#FFFFFF'><center><h1>phind - word not found</h1>
<p> The word &quot;$word&quot; was not found in collection &quot;$collection&quot;
<p>";
    &printform;
    print"</center></body></html>";
    exit(0);
}

