#!/usr/bin/perl

# sru-server.cgi - access a kinosearch index via SRU; just take advantage of the toLucene method

# Eric Lease Morgan <eric_morgan@infomotions.com>
# 2008-02-05 - moved back to beta space (GG died this morning)
# 2007-09-21 - added pager
# 2006-05-31 - output additional dc fields depending on the dc type
# 2006-05-30 - first cut

# require the necessary modules
use CGI qw(-oldstyle_urls);
use CGI::Carp qw(fatalsToBrowser);
use CQL::Parser;
use SRU::Request;
use SRU::Response;
use strict;
use KinoSearch::Searcher;
use KinoSearch::Analysis::PolyAnalyzer;
use warnings;

# where is my index
use constant INDEX => '../etc/index';

# initlize the necessary objects
my $cgi      = CGI->new();
my $request  = SRU::Request->newFromCGI($cgi)          || &error;
my $response = SRU::Response->newFromRequest($request) || &error;

# check for type of response; explain
if ($response->type() eq 'explain') {
	
	# fill up the response's record 
	$response->record(SRU::Response::Record->new(recordSchema => 'http://explain.z3950.org/dtd/2.0/', recordData => &record));

}

# scan
elsif ($response->type() eq 'scan') {

        $response->addDiagnostic(SRU::Response::Diagnostic->newFromCode(4, 'Scan operation is not supported at this stage.'));
        $response->asXML();
}


# search
else {
	
	# parse the query and check it
	my $parser = CQL::Parser->new;
	eval { $parser->parse($request->query) };
    if ($@) {
    
    	$response->addDiagnostic(SRU::Response::Diagnostic->newFromCode(10,$@));
        print $cgi->header('text/xml');
		print $response->asXML();
		exit;

     }
     
    my $node = $parser->parse($request->query);
	
	# search
	my ( $total_hits, @results ) = &search( $node->toLucene );
	
	# process each result
	for (my $i = 0; $i <= $#results; $i++) {

		# check for maximum records
		if (defined($request->maximumRecords)) { last if ($i >= $request->maximumRecords) }
		
		# create a records object and add it to the responee
		my $record = SRU::Response::Record->new(recordSchema => 'info:srw/schema/1/dc-v1.1', recordData => $results[$i]);
		$response->addRecord($record);
	
	}
	
	# include the total number of hits
	$response->numberOfRecords( $total_hits );

}

# done; output the result
print $cgi->header(-type => 'text/xml', -charset => 'utf-8');
print $response->asXML();
exit;


######################################################
# local subroutines; should I make these into methods?

sub record {

	my $email = 'emorgan@nd.edu';
	
	return <<EOF
<explain xmlns="http://explain.z3950.org/dtd/2.0/">
	<serverInfo protocol='SRU' version='1.1'>
		<host>
			dewey.library.nd.edu
		</host>
		<port>
			80
		</port>
		<database>
			morgan/kinosearch/sru/server.cgi
		</database>
	</serverInfo>
	<databaseInfo>
		<title lang='en' primary='true'>
			Fun with KinoSearch
		</title>
		<description lang='en' primary='true'>
			This is just a test to see if I can provide SRU access to a KinoSearch index.
		</description>
		<author lang='en' primary='true'>
			Eric Lease Morgan, University Libraries of Notre Dame
		</author>
		<contact lang='en' primary='true'>
			Eric Lease Morgan ($email)
		</contact>
		<extent lang='en' primary='true'>
			The index contains content from DOAJ, Infomotions' Image Gallery, and a number of MARC records describing 18th century stuff.
		</extent>
		<langUsage lang='en' primary='true' codes='en'>
			All the records in this database are in English.
		</langUsage>
		<implementation lang='en' primary='true'>
			This SRU server is written in Perl through the use of three API's. One for SRU (http://http://search.cpan.org/dist/SRU/). One for CQL (http://search.cpan.org/dist/CQL-Parser/), and one for the underlying indexer/search engine, KinoSearch (http://http://www.kinosearch.com/kinosearch/).
		</implementation>
		<links>
			<link type='www'>
			http://dewey.library.nd.edu/morgan/kinosearch/sru/client.html
			</link>
			<link type='sru'>
			http://dewey.library.nd.edu/morgan/kinosearch/sru/server.cgi
			</link>
		</links>
	</databaseInfo>
	<metaInfo>
		<dateModified>
			2006-05-30 18:12:04
		</dateModified>
	</metaInfo>
	<indexInfo>
		<set identifier='info:srw/cql-context-set/1/dc-v1.1' name='dc' />
		<index>
			<title>
				subject
			</title>
			<map>
				<name set='dc'>
					subject
				</name>
			</map>
		</index>
		<index>
			<title>
				related
			</title>
			<map>
				<name set='dc'>
					related
				</name>
			</map>
		</index>
		<index>
			<title>
				creator
			</title>
			<map>
				<name set='dc'>
					creator
				</name>
			</map>
		</index>
		<index>
			<title>
				publisher
			</title>
			<map>
				<name set='dc'>
					publisher
				</name>
			</map>
		</index>
		<index>
			<title>
				title
			</title>
			<map>
				<name set='dc'>
					title
				</name>
			</map>
		</index>
	</indexInfo>
	<schemaInfo>
		<schema identifier='info:srw/schema/1/dc-v1.1' sort='false' name='dc'>
			<title>
				Dublin Core
			</title>
		</schema>
	</schemaInfo>
	<configInfo>
		<default type='numberOfRecords'>
			250
		</default>
	</configInfo>
</explain>

EOF

}


sub search {

	# initialize
	my $query = $_[0];
	my @results;
	
	# set up KinoSearch
	my $analyzer = KinoSearch::Analysis::PolyAnalyzer->new( language => 'en' );
	my $searcher = KinoSearch::Searcher->new(
		invindex => INDEX,
		analyzer => $analyzer
	);
		
	# search
	my $hits = $searcher->search( $query );
	
	# display the number of hits
	my $total_hits = $hits->total_hits;
		
	# define start and end	
	my $start_record = 0; $start_record = $request->startRecord unless ( ! $request->startRecord );
	my $maximum_records = $total_hits; $maximum_records = $request->maximumRecords unless ( ! $request->maximumRecords );

	if ($total_hits) {
	
		$hits->seek( $start_record, $maximum_records );
		while ( my $hit = $hits->fetch_hit_hashref ) {
					
			# push on to results
			push @results, '<srw_dc:dc xmlns="http://www.w3.org/TR/xhtml1/strict" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:srw_dc="info:srw/schema/1/dc-v1.1"><dc:title>' .  &escape_entities($hit->{title}) . '</dc:title><dc:creator>' .  &escape_entities($hit->{creator}) . '</dc:creator><dc:description>' .  &escape_entities($hit->{description}) . '</dc:description><dc:identifier>' .  &escape_entities($hit->{ identifier }) . '</dc:identifier><dc:subject>' .  &escape_entities($hit->{subject}) . '</dc:subject><dc:publisher>' .  &escape_entities($hit->{publisher}) . '</dc:publisher><dc:collection>' .  &escape_entities($hit->{collection}) . '</dc:collection><dc:date>' .  &escape_entities($hit->{date}) . '</dc:date><dc:format>' .  &escape_entities($hit->{format}) . '</dc:format><dc:rights>' .  &escape_entities($hit->{rights}) . '</dc:rights></srw_dc:dc>'; 			
			
		}
		
	}
	
	# done; return it
	return ( $total_hits, @results );
	
}


sub escape_entities {

	# get the input
	my $s = shift;
	
	# escape
	$s =~ s/&/&amp;/g;
	$s =~ s/</&lt;/g;
	$s =~ s/>/&gt;/g;
	$s =~ s/"/&quot;/g;
	$s =~ s/'/&apos;/g;

	# done
	return $s;
	
}


sub error {

	print $cgi->header();
	print $SRU::Error;
	exit;
	
}