#!/usr/bin/perl -w
#
# Query a z39.50 server with zoomsh.
# 5dec1999/kjl
#
# Usage:
#   for production:
#     put it into your /cgi-bin/ and use it via your browser as
#	http://localhost/cgi-bin/zquery.pl
#   for limited debugging:
#     zquery.pl [querystring]
#
# Installation:
# Edit path to point to the directory where your zoomsh binary is and
# put this script to your cgi-bin directory of the http daemon.
# Additionally, you can modify print_html_* () to customize the appearance
# of the html pages.
#
# Some notes about parsing output from zoomsh:
# read_hash_zoomsh () reads the output from zoomsh and builds a hash
# containing data received from z39.50 server. It uses a simple and
# inefficient parse mechanism without validity check of the returned data.
# It works well enough to experiment with the search system.
#
# If you want to roll your own parser, here are some non special cases:
#
# - lines are continued at next line with leading whitespaces like this:
#   title: This is a very long title line which does not fit in one line and
#     it will be continued at next line, like this
#
# - long lines can look like this:
#   linkage: http://do.main/path/page.html
#	       or
#   linkage:
#     http://do.main/path/page.html
#
# - lines longer than 77 characters are broken into two lines by putting a
#   "=" at position 77 and continued at next line.
#

use CGI 'param';
use CGI::Carp;
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use integer;
use strict;

$::DEBUG = param ('DEBUG');
$::DEBUG = 0 unless ($::DEBUG);

#############################
# configuration starts here #
#############################
# where am I installed?
# this script will find out its location when started as cgi script.
# If you want to use it under mod_perl, move this script to your perl
# modules directory and change the path.
##########################################
$::ME = $ENV { 'SCRIPT_NAME' };
$::ME = "/Harvest/cgi-bin/zquery.pl" unless $::ME;

# path to XML files
#$::DATA_STORE = "http://tengu.local/Harvest/brokers/tengu.local/objects-xml/";

# prefix to supplemental html pages
$::HTML_BASE = "/Harvest/brokers/zquery";

# where is the zebrasrv and the database to use
$::ZURL = "localhost:9999/harvest";	 # how to contact z39.50 server

# some default values
# you can override these with the values of your query form
$::OP	    = "and";	# default boolean operator for queries
#$::OP	     = "or";	 # "and" and "or" allowed
$::N_LINES  = 3;	# default number of lines per hit to show
$::PER_PAGE = 10;	# default number of hits per page to show
# end of configuration
###############################################################################


# exit after this number of seconds
alarm (60);

# where is zoomsh
$::ZOOMSH = "/usr/local/harvest/bin/zoomsh";

# do some sanity checks
test_zebra ();

# parse arguments
# no arguments
# we must be called as a cgi script
$::query = param ('query') if ($#ARGV == -1);

# we found some arguments
$::query = join (" ", @ARGV) if ($#ARGV >= 0);

if ($::query) {

    # page to show
    $::page = param ('page');
    $::page = 0 if (! $::page);

    # number of hits to show per page
    $::per_page = param ('per_page');
    $::per_page = $::PER_PAGE if (! $::per_page);

    # number of lines per entry to show
    $::n_lines = param ('n_lines');
    $::n_lines = $::N_LINES if (! $::n_lines);

    # how to combine query words
    $::op = param ('op');
    $::op = $::OP if (! $::op);

    # build query string in zoomsh notation
    $::z_query = build_query ($::query, $::op);

    $::start = $::page * $::per_page;
    $::zoomq =  "$::ZOOMSH \"connect $::ZURL\" \"search $::z_query\"";
    $::zoomq .= " \"show $::start $::per_page\" quit";

    ($::num_hit, $::aref) = read_hash_zoomsh ();
    @::hits = @{$::aref};

    # output
    print_html_header ("Search result for \"$::query\"");
    print_html_query_form ($::query);
    print "Query sent to Zebra server:<br>\n<b>$::z_query</b>\n<p>\n"
	if ($::DEBUG);
    print_num_hit ($::query, $::num_hit);
    print_hit ($::page, $::per_page, \@::hits)
	if ($::num_hit && $::num_hit > 0);

    # print pager navigation links
    print_html_page_index (uri_escape ($::query), $::num_hit,
			   $::page, $::per_page)
	if ($::num_hit && $::num_hit > $::per_page);

} else { # if ($query)
    print_html_header ("Z39.50 Search");
    print_html_query_form ();
}

print_html_footer ();
#############################################
# execution ends here			    #
#############################################

#############################################
# subroutines				    #
#############################################

#############################################
# html header				    #
#   args: title				    #
#############################################
sub print_html_header {

    my $title = shift;

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


<html>
<head>
<title>$title
</title>
<style><!--
div.pager A { color: black; }
//--></style>
</head>
<body
 bgcolor="#ffffff"
 text="#000000"
 link="#0000ff"
 vlink="#000080"
 alink="#ff0000"
>

EOF
}


#############################################
# html end tags				    #
#############################################
sub print_html_footer {

    print << "EOF";
<hr size=3 width=90% noshade>
<center>
<b>
<a href="$::HTML_BASE/help.html"><nobr>[Help formulating queries]</nobr></a>
<a href="$::HTML_BASE/register.html"><nobr>[Register new pages]</nobr></a>
<a href="$::HTML_BASE/contact.html"><nobr>[Contact information]</nobr></a>
<a href="$::HTML_BASE/about.html"><nobr>[About this search system]</nobr></a>
</b>
</center>
<br>
<br>
</body>
</html>
EOF
}


#############################################
# query form				    #
#   args: default querystring value	    #
#############################################
sub print_html_query_form {

    my $query = shift;

    $::op = $::OP unless ($::op);
    $::n_lines = $::N_LINES unless ($::n_lines);
    $::per_page = $::PER_PAGE unless ($::per_page);

    print << "EOF";
<table>
<tr>
<td><a href="$::HTML_BASE\/"><h1>Harvest</h1></a></td>
<td>&nbsp;&nbsp;&nbsp;</td>
<td>
<form action=$::ME method=get>

<nobr>
<input type=text name=query
EOF

    if ($query) {
	$query =~ s/\"/&quot;/g;
	print " value=\"$query\"";
    }

    print << "EOF";
 size=40 maxsize=200>
<input type=submit name=what value=Search>
</nobr>

<input type=hidden name=op value=$::op>
<input type=hidden name=n_lines value=$::n_lines>
<input type=hidden name=per_page value=$::per_page>
<input type=hidden name=DEBUG value=$::DEBUG>
</form>
</td>
</tr>
</table>

EOF
}


#############################################
# print number of hits for a query	    #
# args: querystring, number_of_hits	    #
#############################################
sub print_num_hit {

    my $query = shift;
    my $num_hit = shift;

    print "<b>$query:</b> ";

    if (! $num_hit) {
	print << "EOF";
<p>
No documents were found matching your query.
<p>
Please:
<ul>
<li>Verify that the spelling of the search terms were correct.
<li>Choose fewer search terms.
<li>Choose more general search terms.
</ul>
<p>
EOF
	return;
    } elsif ($num_hit == 1) {
	print "$num_hit match";
    } else {
	print "$num_hit matches";
    }

    print " found\n";
    print "<br><br>\n";
}


#############################################
# print hits				    #
# arguments:				    #
#   number of page			    #
#   hits per page			    #
#   hash of hit arrays			    #
#############################################
sub print_hit {

    my ($page, $per_page, $aref, @hits, $i, $entry, $key); #, $obj_data);
    my ($rank, $title, $last_modification_time, $file_size, $url, $full_text);
    my (@date);

    $page = shift;
    $per_page = shift;
    $aref = shift;
    @hits = @{$aref};

    $entry = $page * $per_page;

    for $i (0 .. $#hits) {

	$entry++;

	$rank			= $hits [$i] { 'rank' };
	$url			= $hits [$i] { 'url' };
	$last_modification_time = $hits [$i] { 'last-modification-time' };
	$file_size		= $hits [$i] { 'file-size' } / 1024;
	$file_size		= 1 if ($file_size == 0);
	$title			= $hits [$i] { 'title' };
	$full_text		= $hits [$i] { 'full-text' };

	@date = gmtime ($last_modification_time);
	$last_modification_time = sprintf ("%d-%02d-%02d",
					   $date[5] + 1900, $date[4] + 1,
					   $date[3]);

	print "<b>$entry. </b>" if ($::DEBUG);
	print << "EOF";
<b><a href="$url">$title</a></b>
<br>
$full_text
<br>
EOF

	$url =~ s/^http\:\/\///g;
	print "$url <b>$file_size";
	print "KB $last_modification_time</b><br>\n";

	if ($::DEBUG) {
	    print "Relevance ranking value: $rank\n";
	    print "<br>\n";

	    # show raw data for debugging
	    # how do I get the filename of a hit?
	    # $obj_data = ... ?
	    # print "<a href=" . $::DATA_STORE . $obj_data . ">";
	    # print "Object data</a>\n";
	    # print "<br>\n";
	}

	print "<br>\n";

    }
}


###############################
# print page-navigation links #
# args:			      #
#   querystring		      #
#   number of hits	      #
#   page number		      #
#   number of items per page  #
###############################
sub print_html_page_index {

    my ($query, $num_hit, $page, $per_page);
    my ($url, $num_pages, $start, $i);

    $query    = shift;
    $num_hit  = shift;
    $page     = shift;
    $per_page = shift;

    $url =  "$::ME";
    $url .= "?query=$query";
    $url .= "&op=$::op";
    $url .= "&n_lines=$::n_lines";
    $url .= "&per_page=$per_page";
    $url .= "&DEBUG=$::DEBUG" if ($::DEBUG);

    $num_pages = $num_hit / $per_page;
    $num_pages++ if ($num_hit % $per_page);

    print "<center>\n";
    print "<div class=pager>\n";

    print "<a href=$url&page=" . ($page - 1) . ">Previous</a>&nbsp;\n"
	if ($page > 0);

    $start = $page - 5 if ($page > 5);
    $start = $start - ($page + 6 - $num_pages) if ($num_pages <= $page + 5);
    $start = 0 if (!defined $start || $start < 0);

    for ($i = $start; $i < $page; $i++) {
	print "<a href=$url&page=$i>" . ($i + 1) . "</a>&nbsp;\n";
    }

    print "<font color=red><b>";
    print $page + 1;
    print "</b></font>&nbsp;\n";

    for ($i = $page + 1; $i < $num_pages && $i < $start + 11; $i++) {
	print "<a href=$url&page=$i>" . ($i + 1) . "</a>&nbsp;\n";
    }

    print "<a href=$url&page=" . ($page + 1) . ">Next</a>\n"
	if ($page < $num_pages - 1);

    print "</div>\n";
    print "</center>\n";
}


#############################################
# print error page and exit		    #
# args: error message			    #
#############################################
sub print_html_error {

    my $reason = shift;

    print_html_header ("Service temporarily not available");
    print "<h1 align=center>Service temporarily not available</h1>\n";
    print "<center>Reason: <b>$reason</b>.</center>\n";
    print_html_footer ();
    exit;
}


##########################################################
# test that everything necessary is in place and running #
# args: none						 #
##########################################################
sub test_zebra {

    # can't find zoomsh
    print_html_error ("Can't run $::ZOOMSH") if (!-x "$::ZOOMSH");

    # can't connect to zebrasrv
    open (IN, "$::ZOOMSH \"connect $::ZURL\" quit|");
    print_html_error ("Can't connect to zebrasrv at $::ZURL") if (<IN>);
    close (IN);
}


##################################################
# read search results from zoomsh		 #
# args: none					 #
# returns:					 #
#   number of total hits			 #
#   hash with search result			 #
##################################################
sub read_hash_zoomsh {

    my ($num_hit, @hits, $i, $j, $tmp);

    open (IN, "$::zoomq|");

    $_ = <IN>;

    # parse number of hits
    ($num_hit) = /^.*: (\d+) hits$/;

    # build a list of hashes with hits
    $i = -1;
    $_ = <IN>;
    while ($_) {

	# one liners
	if (/^xsoif:$/) {
	# if (/^local-control-number: \d+$/) {
	    $i++;
	    $_ = <IN>;
	    next;
	}

	if (/^\s+rank: \d+$/) {
	    ($hits [$i] { 'rank' }) = /^\s+rank: (\d+)$/;
	    $_ = <IN>;
	    next;
	}

	if (/^\s+last-modification-time: \d+$/) {
	    ($hits [$i] { 'last-modification-time' }) =
		/^\s+last-modification-time: (\d+)$/;
	    $_ = <IN>;
	    next;
	}

	if (/^\s+file-size: \d+$/) {
	    ($hits [$i] { 'file-size' }) = /^\s+file-size: (\d+)$/;
	    $_ = <IN>;
	    next;
	}

	# multi liners
	if (/^\s+title:/) {
	    ($hits [$i] { 'title' }) = /^\s+title: (.+)$/;
	    $_ = <IN>;
	    while (($_) && (/^\s{4}.+$/)) {
		if ($hits [$i] { 'title' }) {
		    if ($hits [$i] { 'title' } =~ /\S=$/) {
			chop $hits [$i] { 'title' };
		    } else {
			$hits [$i] { 'title' } .= " ";
		    }
		}

		$_ =~ s/^\s+//g;
		chop;
		$hits [$i] { 'title' } .= $_;
		$_ = <IN>;
	    }
	    $hits [$i] { 'title' } = remove_quirks ($hits [$i] { 'title' });
	    next;
	}

	if (/^\s+full-text:/) {
	    ($hits [$i] { 'full-text' }) = /^\s+full-text: (.+)$/;
	    $_ = <IN>;
	    $j = 0;
	    while (($_) && ($j < $::n_lines) && (/^\s{4}.+$/)) {
		if ($hits [$i] { 'full-text' }) {
		    if ($hits [$i] { 'full-text' } =~ /\S=$/) {
			chop $hits [$i] { 'full-text' };
		    } else {
			$hits [$i] { 'full-text' } .= " ";
		    }
		}

		$_ =~ s/^\s+//g;
		chop;
		$hits [$i] { 'full-text' } .= $_;
		$_ = <IN>;
		$j++;
	    }
	    $hits [$i] { 'full-text' } =
		remove_quirks ($hits [$i] { 'full-text' });
	    next;
	}

	if (/^\s+url:/) {
	    ($hits [$i] { 'url' }) = /^\s+url: (.+)$/;
	    $_ = <IN>;
	    while (($_) && (/^\s{4}.+$/)) {
		if (($hits [$i] { 'url' }) &&
		    ($hits [$i] { 'url' } =~ /\S+=$/)) {
		    chop $hits [$i] { 'url' };
		}

		$_ =~ s/^\s+//g;
		chop;
		$hits [$i] { 'url' } .= $_;
		$_ = <IN>;
	    }
	    next;
	}

	$_ = <IN>;
    }

    close (IN);

    # print all parsed lines for debugging
    # keys used to print search results
    #@::keys = ("rank", "url", "last-modification-time",
    #	   "file-size", "title", "full-text");
    #foreach $i (0 .. $#hits) {
    #	foreach my $key (@::keys) {
    #	    print $i, " ->> ", $key, " ->> ", $hits [$i] { $key }, "\n";
    #	}
    #	print "---------------------\n";
    #}

    #######################################################################
    # Postprocessing							  #
    # we have to filter this after a full build of the hash because	  #
    # we don't know when both, title and sample fields are initialized.	  #
    #######################################################################
    # title is sometimes repeated at the beginning of sampletext and some #
    # documents doesn't have any title at all.				  #
    # to do search and replace, meta characters must be escaped		  #
    #######################################################################
    foreach $i (0 .. $#hits) {
	if ($hits [$i] { 'title' }) {
	    $tmp = quotemeta ($hits [$i] { 'title' });
	    $hits [$i] { 'full-text' } =~ s/^$tmp //g;
	} else {
	    $hits [$i] { 'title' } = $hits [$i] { 'url' };
	}
	if (length ($hits [$i] { 'title' }) > 60) {
	    $hits [$i] { 'title' } =
		substr ($hits [$i] { 'title' }, 0, 60) . "...";
	}
    }

    return $num_hit, \@hits;
}


#############################################
# build a query string from input	    #
# args: complete query string		    #
# returns: query string in Zebra's client   #
#	   notation			    #
#############################################
sub build_query {

    my ($query, $attr, @token, $op, $i, $z_query, $quoted);

    $query = shift;
    $op = shift;

    $query =~ s/\s+/ /g;    # collapse multiple whitespaces to one
    $query =~ s/\s+$//g;    # remove trailing whitespaces
    $query =~ s/\"/\\\"/g;

    # request ranking
    #$attr = "\@attr 2=102 ";

    $attr =  "\@attr 1=/xsoif/url ";
    $attr .= "\@attr 1=/xsoif/title ";
    $attr .= "\@attr 1=/xsoif/author ";
    $attr .= "\@attr 1=/xsoif/headings ";
    $attr .= "\@attr 1=/xsoif/keywords ";
    $attr .= "\@attr 1=/xsoif/description ";
    $attr .= "\@attr 1=/xsoif/full-text ";

    # make it a regexp search, if any of these special characters are found
    # in query string: ".[]*+?|"
    $attr .= "\@attr 5=102 " if ($query =~ /\.|\[|\]|\*|\+|\?|\|/);

    @token = split /\s+/, $query;
    if ($#token < 0) {
	$z_query = "";
    } else {
	$quoted = 0;
	foreach (@token) {
	    if ($quoted == 1) {
		$z_query .= " $_";
	    } else {
		if ($z_query) {
		    if (/^\-/) {
			s/^\-//g;
			$z_query = "\@not $z_query " . $attr . $_;
		    } else {
			$z_query = "\@$op $z_query " . $attr . $_;
		    }
		} else {
		    $z_query = $attr . $_;
		}
	    }
	    $quoted = 1 if (/^\\\"/);
	    $quoted = 0 if (/\S+\\\"$/);
	}
    }

    return $z_query;
}


#############################################
# strip html tags still left in summarized  #
# data and map dangerous letters	    #
# args: text to strip			    #
# returns: stripped text		    #
#############################################
sub remove_quirks {

    my $line = shift;

    $line =~ s/</\&lt;/g;
    $line =~ s/>/\&gt;/g;

    return $line;
}
