#!/usr/bin/perl

# bl.cgi - an SRU interface to the British Libary catalogue, with spell check

# Eric Lease Morgan <emorgan@nd.edu>
# September 22, 2005 - changed dictionary to library, not master; seems better
# September 21, 2005 - Done, sort of
# September 18, 2005 - First cut

# define constants
use constant HOME       => 'etc/home.txt';
use constant FORM       => 'etc/form.txt';
use constant RESULTS    => 'etc/results.txt';
use constant NOHITS     => 'etc/nohits.txt';
use constant SPELL2WORD => 'etc/spell2word.xsl';
use constant SRU2HTML   => 'etc/sru2html.xsl';
use constant SRU2HITS   => 'etc/sru2hits.xsl';
use constant SPELLROOT  => 'http://spell.ockham.org/?dictionary=library&word=';
use constant LOCROOT    => 'http://herbie.bl.uk:9080/cgi-bin/blils.cgi?recordSchema=dc&version=1.1&maximumRecords=10&operation=searchRetrieve&query=';
use constant TEMPLATE   => 'etc/template.txt';

# require/use
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use LWP::UserAgent;
use XML::LibXML;
use XML::LibXSLT;

# initialize
my $cgi = CGI->new;
my $html;

# get the command
my $cmd = $cgi->param('cmd');

# branch accordingly
if (! $cmd) {

	# display the home page
	$html = &slurp(TEMPLATE);
	$html =~ s/##CONTENT##/&slurp(HOME)/e;
	$html =~ s/##FORM##/&slurp(FORM)/e;
		
}

		
elsif ($cmd eq 'search') {
	
	# get the input
	my $query = $cgi->param('query');
		
	# do simple munging of the query; try to force it into CQL
	if ($query =~ /\s/) {
	
		if (($query =~ / and /) | ($query =~ / or /) | ($query =~ / not /)) { }		
		elsif ($query =~ /=/) { }
		elsif ($query !~ /"/) {
		
			# try to make queries with no syntactical sugar a bit "smarter"
			my @terms = split / /, $query;
			my $enhancement;
			for (my $i; $i <= $#terms; $i++) {
			
				if ($i < $#terms) { $enhancement .= $terms[$i] . ' and ' }
				else { $enhancement .= $terms[$i] }
			
			}
			
			$query = '"' . $query . '"' . " or ($enhancement)";
			
		}
		
	}
	
	# begin to complete the search results page
	$html = &slurp(TEMPLATE);
	$html =~ s/##CONTENT##/&slurp(RESULTS)/e;

	# create a user agent, create a request, send it, and get a response
	my $ua = LWP::UserAgent->new(agent => 'SRU-Client/0.1 ');
	my $request = HTTP::Request->new(GET => LOCROOT . $query);
	my $response = $ua->request($request);
	

	# check response
	if ($response->is_success) {
	
		# create parser and process input
		my $parser     = XML::LibXML->new;
		my $xslt       = XML::LibXSLT->new;
		
		# parse the result to get the number of hits
		my $source     = $parser->parse_string($response->content) or croak $!;
		my $style      = $parser->parse_file(SRU2HITS)             or croak $!;
		my $stylesheet = $xslt->parse_stylesheet($style)           or croak $!;
		my $results    = $stylesheet->transform($source)           or croak $!;
		
		# branch accodingly
		if ($stylesheet->output_string($results) > 0) {
		
			my $source     = $parser->parse_string($response->content) or croak $!;
			my $style      = $parser->parse_file(SRU2HTML)             or croak $!;
			my $stylesheet = $xslt->parse_stylesheet($style)           or croak $!;
			my $results    = $stylesheet->transform($source)           or croak $!;
			
			# update the output
			$html =~ s/##RESULTS##/$stylesheet->output_string($results)/e;
			$html =~ s/##QUERY##/$query/e;
			$html =~ s/##FORM##/&slurp(FORM)/e;
		
		}
		
		else {
		
			# parse the query
			my @query = split / /, $cgi->param('query');
			
			# initialize the new query
			my $new_query;
			
			# process each query word
			foreach my $q (@query) {
			
				# create a user agent, create a request, send it, and get a response
				my $ua = LWP::UserAgent->new(agent => 'SPELL-Client/0.1 ');
				my $request = HTTP::Request->new(GET => SPELLROOT . $q);
				my $response = $ua->request($request);
				
				# parse the result to get the first suggestion
				my $parser     = XML::LibXML->new;
				my $xslt       = XML::LibXSLT->new;
				my $source     = $parser->parse_string($response->content) or croak $!;
				my $style      = $parser->parse_file(SPELL2WORD)             or croak $!;
				my $stylesheet = $xslt->parse_stylesheet($style)           or croak $!;
				my $results    = $stylesheet->transform($source)           or croak $!;

				# build new query
				$new_query .= $stylesheet->output_string($results) . ' ';
			
			}
						
			# create a suggestion
			$new_query = substr($new_query, 0, -1);
			my $suggestion = "<a href='?cmd=search&query=$new_query'>$new_query</a>";
			
			# update the output
			$html =~ s/##RESULTS##/&slurp(NOHITS)/e;
			$html =~ s/##QUERY##/$query/e;
			$html =~ s/##SUGGESTION##/$suggestion/e;
			$html =~ s/##FORM##/&slurp(FORM)/e;
		
		}
					
	}
	
	else { $html = $response->status_line, "\n" }
		
}

else {

	# error
	$html  = $cgi->start_html(-title => 'Smart Spell client');
	$html .= $cgi->h1('Smart Spell client');
	$html .= $cgi->p("Unknown value for cmd ($cmd). Call Eric.");
	$html .= $cgi->end_html;

}


# done
print $cgi->header(-type=>'text/html', -charset => 'UTF-8');
print $html;


sub slurp {

	# open a file named by the input and return its contents
	my $f = @_[0];
	my $r;
	open (F, "< $f");
	while (<F>) { $r .= $_ }
	close F;
	return $r;

}