#!/usr/bin/perl

# CGI script to display individual sentences that match a query.
# (Textpresso system)
# 
# copyright (c) Hans-Michael Muller, Pasadena, California, 2002-2004
#

use strict;
use CGI;

### globals
#

# handle to this CGI and own address
my $query = new CGI;
my $absmyself = $query->url(absolute=>1);

# directories of importance

my $databaseroot = "/var/www/html/text/tdb/";

# add more as you go along

# cookies
my %generalsettings = $query->cookie('generalsettings'); # general settings
my %displayvalues; # display values
if ($query->cookie('displayvalues')) {
    %displayvalues = $query->cookie('displayvalues');
} else {
    $displayvalues{ResultsPerPage} = 10;
    $displayvalues{SentencesPerMatch} = 10;
}

# other globals of interest
my %targetdirectories = (Author => 'aut/', Title => 'tit/', Abstract => 'abs/', Paper => 'art/');

my @categorycolors = qw(red blue fuchsia green lime maroon navy olive purple aqua silver teal yellow white);
my @keywordcolors = qw(blueviolet darkred orange darkslateblue honeydew gold darkgreen darkmagenta orchid);
my %labels = ReadElements("/var/www/html/text/textpresso.dtd");
    
my $displaypage = 1;
my $totalpages = $query->param('totalpages');

#
### end of globals

### process form
#

if ($query->param('display')) {
    $displaypage = $query->param('page');
}
    
if ($query->param('previouspage')) {
    if ($query->param('page') == 1) {
	$displaypage = 1;
	$query->param(-name => 'page', -value => 1);
    } else {
	$displaypage = $query->param('page') - 1;
	$query->param(-name => 'page', -value => $displaypage);
    }
} elsif ($query->param('nextpage')) {
    $displaypage = $query->param('page') + 1;
    $displaypage = ($displaypage > $totalpages) ? $totalpages : $displaypage;
    $query->param(-name => 'page', -value => $displaypage);
}

#
###


PrintHeader($query);

### start form
#

print $query->start_form(-method => 'POST', -action => $absmyself);

#
###

### first part of output goes here
#

my $filename = $databaseroot . "tmp/file" . $query->param('id');
open (IN, "$filename");
my $categoryline = <IN>;
chomp($categoryline);
my $keywordline = <IN>;
chomp ($keywordline);

my @aux = split ("\,", $categoryline);
my @categories;
my @catcomments;
foreach my $element (@aux) {
    (my $cat, my $comment) = split(/\#/, $element);
    do {
	push @categories, $cat;
	push @catcomments, $comment;
    } unless ($element eq "");
}
@aux = split ("\,", $keywordline);
my @keywords;
my @keycomments;
foreach my $element (@aux) {
    (my $key, my $comment) = split(/\#/, $element);
    push @keywords, $key;
    push @keycomments, $comment;
}

print $query->font({-face => 'verdana, helvetica', -size => '3'},
                   'Query: ');
if (@categories) {
    print $query->font({-face => 'verdana, helvetica', -size => '3'},
		       'Categories ');
    for (my $i = 0; $i < @categories; $i++) {
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3'}, " + ");
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3',
			    -color => $categorycolors[$i]},
			   $labels{$categories[$i]}, " ");
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3'}, " (",
			   $catcomments[$i], " ) ") if ($catcomments[$i]);
    }
}
if (@keywords) {
    print $query->font({-face => 'verdana, helvetica', -size => '3'},
		       '- Keywords ');
    for (my $i = 0; $i < @keywords; $i++) {
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3'}, " + ");
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3',
			    -color => $keywordcolors[$i]},
			   $keywords[$i], " ");
	print $query->font({-face => 'verdana, helvetica', 
			    -size => '3'}, " (",
			   $keycomments[$i], " ) ") if ($keycomments[$i]);

    }
}

my $total = 0; # calulate the totals here.
my %displaylist = ();
while (my $line = <IN>) {
    chomp ($line);
    my @items = split (/\,/, $line);
    my $target = shift(@items);
    my $key = shift(@items);
    while (my $sentence = shift(@items)) {
	$total++;
	$displaylist{$target}{$key}{$sentence} = 1;
    }
}
close (IN);

#
###



### present input fields
#

print $query->p;
print $query->submit(-name => 'display', -value => 'Display');
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ' page ');
my @choices;
$totalpages = int($total/($displayvalues{ResultsPerPage} || 10) + 1);
$query->param(-name => 'totalpages', -value => $totalpages);
for (my $j = 0; $j < $totalpages; $j++) {
    push @choices, $j + 1;
}
print $query->popup_menu(-name =>'page',
			 -default => $displaypage,
			 -values => \@choices);
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ', or ');
print $query->submit(-name =>'previouspage', -value => 'previous');
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ' or ');
print $query->submit(-name =>'nextpage', -value => 'next');
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ' page.');
print $query->p;
print $query->hr;
#
###

### second part of output goes here
#

my $counter = 0;
my %sorteddisplaylist = SortedList(\%displaylist);
foreach my $score (sort numerically keys % sorteddisplaylist) {
    foreach my $target (sort keys % { $sorteddisplaylist{$score}}) {
	foreach my $key (sort keys %{ $sorteddisplaylist{$score}{$target}}) {
	    foreach my $sentence (sort sortsen keys %{ $sorteddisplaylist{$score}{$target}{$key}}) {
		$counter++;
		next unless ($counter > $displayvalues{ResultsPerPage}*($displaypage-1));
		next unless ($counter <= $displayvalues{ResultsPerPage}*$displaypage);
		my @output = GetSentencesAsHtml($query, $target, $key, $sentence,
						$displayvalues{SentencesPerMatch},
						\%targetdirectories, $databaseroot,
						\@categories, \@categorycolors,
						\@keywords, \@keywordcolors);
		foreach my $line (@output) {
		    print $line;
		}
	    }
	}
    }
}

print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   'Go to ');
print $query->submit(-name =>'previouspage', -value => 'previous');
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ' or ');
print $query->submit(-name =>'nextpage', -value => 'next');
print $query->font({-face => 'verdana, helvetica', -size => '2'},
		   ' page.');
print $query->p;
#
###

### end form here
#

print $query->hidden(-name => 'id', -default => $query->param('id'));
print $query->hidden(-name => 'totalpages', -default => $totalpages);

my $refid = $query->param('id');
if ($refid =~ m/.*?\.(\D+)(\d+)/) {
	$refid = $1 . ': ' . $2;
}
print $query->hidden(-name => 'refid', -id => 'refid', -default => $refid);


print $query->end_form;
print $query->end_html;

#
###

sub sortsen {

    $a =~ s/s//;
    $b =~ s/s//;
    $a <=> $b;
}

sub GetSentencesAsHtml {

    my $query = shift;
    my $target = shift;
    my $key = shift;
    my $sentence = shift;
    my $halfwidth = shift;
    my $pTargetdirectory = shift;
    my $databaseroot = shift;
    my $pCategories = shift;
    my $pCatcolors = shift;
    my $pKeywords = shift;
    my $pKeywordcolors = shift;

    (my $center = $sentence) =~ s/s//;
    my $start = $center - $halfwidth;
    my $end = $center + $halfwidth;
    $start = ($start > 0) ? $start : 1;

    my @output = ();
    push @output, $query->start_b;
    push @output, $query->font({-face => 'verdana, helvetica', -size => '2'},
			       "File ID " . $key . " ($target), ");
    push @output, $query->font({-face => 'verdana, helvetica', -size => '2'},
			       "Sentences $start to $end: ");
    push @output, $query->end_b;

    my $linkdir = $databaseroot . "wbl/";
    for (my $i = $start; $i < $end + 1; $i++) {
	my $filename = $databaseroot . $$pTargetdirectory{$target} . "xml/" . $key;
	my $content = GetContentsOfSentence($filename, $i);
	my @stripped = ProcessXMLTags($query, $content, 
				      $pCategories, $pCatcolors,
				      $pKeywords, $pKeywordcolors);
	my $indexfile = $databaseroot . "/ind/wbl/" . $$pTargetdirectory{$target} . $key;
	my $line = WormBaseLinks41Sent($indexfile, $linkdir, $query,
				       join(/ /, @stripped), "s$i");
	if ($i == $center) { push @output, $query->start_b; }
	push @output, $line;
	if ($i == $center) { push @output, $query->end_b; }
    }
    push @output, $query->br;
    if (-e "$databaseroot/pdf/$key.pdf") {
	if ($query->remote_host() =~ /(131\.215\.|\.caltech\.edu)/) {
	    push @output, $query->a({href =>"/text/tdb/pdf/$key.pdf", target => "_blank"},
				    $query->img({-src => "/text/gif/pf.jpg", -border => 0, -alt => 'PDF'})); 
	}
    }
    if (-e "$databaseroot/url/$key") {
	open (URL, "$databaseroot/url/$key");
	my $url = <URL>;
	chomp ($url);
	push @output, $query->a({href => "$url", target => "_blank"},
			      $query->img({-src => "/text/gif/ot.jpg", -border => 0, -alt => 'article text from journal'}));

	close(URL);
    }

    push @output, $query->hr;
    return @output;

} # end Get SentencesAsHtml

sub PrintHeader { # begin PrintHeader
    
    my $query = shift;
    my @cookies = ();
    while (@_) { push @cookies, shift(@_)}
    
    print $query->header(-cookie=>[@cookies]);
    print $query->start_html(-title=>'Show Matches', -author=>'Hans-Michael Muller',
			     -bgcolor => '#FFFFFF',
			     -text=>'#000000', -link=>'#662222', -vlink=>'#993333');
    #print $query->br;
    print $query->font({-face => 'verdana, arial, helvetica', -size => '5'}, 'Show Matches');
    print $query->p;
    print $query->font({-face => 'verdana, arial, helvetica'}, 'Note: The color scheme only highlights words that are in the selected categories. It does not mean that other specifications for that word are met. In the color scheme, keyword colors supersede category colors, but are superseded by the ');
    print $query->font({-face => 'verdana, arial, helvetica', -color => '#662222'}, 'hyperlink color');
    print $query->font({-face => 'verdana, arial, helvetica'}, '.');
    print $query->p;
    
} # end PrintHeader

sub PrintBottom { # begin PrintBottom
    my $query = shift;
}   # end PrintBottom

sub ReadElements {

    my $dtdfile = shift;
    my %labels = ();
    $labels { "" } = "none"; # include empty tag for search
    open (DTDFILE, "$dtdfile") or die "Can't open DTD file $dtdfile.";   

    while (my $line = <DTDFILE>) {
	chomp ($line);
	if ($line =~ /<!ELEMENT\s+(\w+)\s\(\#PCDATA\)> <\!--\s((\w|\s)+)\s-->/) {
	    my $key = $1;
	    my $label = $2;
	    if (($key ne "sentence") && ($key ne "article")){  #because pattern above is more specific, this isn't really necessary
		 $labels { substr($key, 0, 2) } = $label;
	    }
	}
    }
    close (DTDFILE);
    return %labels;
}

sub GetContentsOfSentence {

    my $filename = shift;
    my $number = shift;
    open (IN,"$filename");
    while (my $line = <IN>) { 
	next unless ($line =~ /<sentence id=\'s$number\'>/);
	close (IN);
	return $line;
    }
    close (IN);
    return "";
}

sub EliminateXMLTags {

    my $line = shift;
    $line =~ s/<.+?>//g;
    $line =~ s/<\/.+?>//g;
    return $line;
}

sub ProcessXMLTags {

    my $query = shift;
    my $line = shift;
    my $pCategories = shift;
    my $pCatcolors = shift;
    my $pKeywords = shift;
    my $pKeywordcolors = shift;

    my @return = ();
    
    my @matches = $line =~ /(<.+?>.+?<\/.+?>)/g;
    
    foreach my $match (@matches) {
	my $stripped = EliminateXMLTags($match);
	my $prevalenttextcolor = "black";
	for (my $i = 0; $i < @$pCategories; $i++) {
	    my $trgt = "<" . $$pCategories[$i];
	    if ($match =~ /$trgt.+?>/) {
		$prevalenttextcolor = $$pCatcolors[$i];
	    }
	}
	my $textcolor = $prevalenttextcolor;
	for (my $i = 0; $i < @$pKeywords; $i++) {
	    (my $comparison = $$pKeywords[$i]) =~ s/\*/\.\*/g; # correct wildcard sign
	    my @found = $stripped =~ /\s*$comparison\s*/gi;
	    foreach my $ff (@found) {
		my $replacement = " " . $query->font({-color => $$pKeywordcolors[$i]}, " " . $ff . " ");
		$stripped =~ s/(^|\s)$ff($|\s)/$replacement/g;
	    }
	}
	if ($textcolor ne "black") {
	    push @return, $query->font({-color => $textcolor}, 
				       " " . $stripped . " ");
	} else {
	    push @return, " " . $stripped . " ";
	}
    }   
    return @return;
}

sub numerically { $b <=> $a }

sub SortedList {

    my $pSearchresults = shift;
    
    my %scorelist = ();
    foreach my $target (keys % {$pSearchresults}) {
	foreach my $key (keys % { $$pSearchresults{$target} }) {
	    foreach my $sentence (keys % { $$pSearchresults{$target}{$key} }) {
		$scorelist{$key} += $$pSearchresults{$target}{$key}{$sentence};
	    }
	}
    }
    
    my %sortscorelist = ();
    foreach my $target (keys % {$pSearchresults}) {
	foreach my $key (keys % { $$pSearchresults{$target} }) {
	    foreach my $sentence (keys % { $$pSearchresults{$target}{$key} }) {
		$sortscorelist{$scorelist{$key}}{$target}{$key}{$sentence} = 1;
	    }
	}
    }

    return %sortscorelist;
}

sub WormBaseLinks41Sent {

    my $indexfile = shift;
    my $linkdir = shift;
    my $query = shift;
    my $line = shift;
    my $id = shift;


    if (-e "$indexfile") {
        my %indexcontent = ();
        open (INDEX, $indexfile);
        while (my $line = <INDEX>) {
            chomp $line;
            my @words = split(/\t/, $line);
            my $id = shift(@words);
            while (@words) { push @{ $indexcontent{$id} }, shift(@words)};
        }
        close (INDEX);
	if ($indexcontent{$id}) {
	    while (@{$indexcontent{$id}}) {
		my $term = shift (@{$indexcontent{$id}});
		(my $lookup = $term) =~ s/\s//g;
		my $lcflookup = lcfirst($lookup);
		open (URL, "$linkdir/$lookup") or open(URL, "$linkdir/$lcflookup");
		my $url = <URL>;
		close (URL);
		if ($url) {
		    chomp($url);
		    my $replacement = " " . $query->a({-href => $url, -target => '_blank'}, "$term") . " ";
		    $line =~ s/(^|\s)$term($|\s)/$replacement/g;
		}
	    }
	}
    }
    return $line;
}