package OpenILS::WWW::SuperCat;
use strict; use warnings;
use Apache2::Log;
use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
use APR::Const -compile => qw(:error SUCCESS);
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil;
use CGI;
use Data::Dumper;
use SRU::Request;
use SRU::Response;
use OpenSRF::EX qw(:try);
use OpenSRF::Utils qw/:datetime/;
use OpenSRF::Utils::Cache;
use OpenSRF::System;
use OpenSRF::AppSession;
use XML::LibXML;
use XML::LibXSLT;
use Encode;
use Unicode::Normalize;
use OpenILS::Utils::Fieldmapper;
use OpenILS::WWW::SuperCat::Feed;
use OpenSRF::Utils::Logger qw/$logger/;
use OpenILS::Application::AppUtils;
use OpenILS::Utils::TagURI;
use MARC::Record;
use MARC::File::XML ( BinaryEncoding => 'UTF-8' );
my $log = 'OpenSRF::Utils::Logger';
my $U = 'OpenILS::Application::AppUtils';
# set the bootstrap config when this module is loaded
my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
my $authority_axis_re = qr/^authority\.(\w+)(\.refs)?$/;
my %extra_header_action_per_type = (
marc21 => [
{"Content-Disposition" =>
sub { "attachment;filename=" . time . ".mrc"}}
]
);
$browse_types{call_number}{xml} = sub {
my $tree = shift;
my $year = (gmtime())[5] + 1900;
my $content = '';
$content .= "\n";
for my $cn (@$tree) {
(my $cn_class = $cn->class_name) =~ s/::/-/gso;
$cn_class =~ s/Fieldmapper-//gso;
my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
my $cn_lib = $cn->owning_lib->shortname;
my $cn_label = $cn->label;
my $cn_prefix = $cn->prefix->label;
my $cn_suffix = $cn->suffix->label;
$cn_label =~ s/\n//gos;
$cn_label =~ s/&/&/go;
$cn_label =~ s/'/'/go;
$cn_label =~ s/</go;
$cn_label =~ s/>/>/go;
$cn_prefix =~ s/\n//gos;
$cn_prefix =~ s/&/&/go;
$cn_prefix =~ s/'/'/go;
$cn_prefix =~ s/</go;
$cn_prefix =~ s/>/>/go;
$cn_suffix =~ s/\n//gos;
$cn_suffix =~ s/&/&/go;
$cn_suffix =~ s/'/'/go;
$cn_suffix =~ s/</go;
$cn_suffix =~ s/>/>/go;
(my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
$ou_class =~ s/Fieldmapper-//gso;
my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
my $ou_name = $cn->owning_lib->name;
$ou_name =~ s/\n//gos;
$ou_name =~ s/'/'/go;
(my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
$rec_class =~ s/Fieldmapper-//gso;
my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
$content .= "\n";
$content .= "\n";
my $r_doc = $parser->parse_string($cn->record->marc);
$r_doc->documentElement->setAttribute( id => $rec_tag );
$content .= $U->entityize($r_doc->documentElement->toString);
$content .= "\n";
}
$content .= "\n";
return ("Content-type: application/xml\n\n",$content);
};
$browse_types{call_number}{html} = sub {
my $tree = shift;
my $p = shift;
my $n = shift;
if (!$cn_browse_xslt) {
$cn_browse_xslt = $parser->parse_file(
OpenSRF::Utils::SettingsClient
->new
->config_value( dirs => 'xsl' ).
"/CNBrowse2HTML.xsl"
);
$cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
}
my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
return (
"Content-type: text/html\n\n",
$U->entityize(
$cn_browse_xslt->transform(
$parser->parse_string( $xml ),
'prev' => "'$p'",
'next' => "'$n'"
)->toString(1)
)
);
};
sub import {
my $self = shift;
$bootstrap = shift;
}
sub child_init {
OpenSRF::System->bootstrap_client( config_file => $bootstrap );
my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
Fieldmapper->import(IDL => $idl);
$supercat = OpenSRF::AppSession->create('open-ils.supercat');
$actor = OpenSRF::AppSession->create('open-ils.actor');
$search = OpenSRF::AppSession->create('open-ils.search');
$parser = new XML::LibXML;
$xslt = new XML::LibXSLT;
$cn_browse_xslt = $parser->parse_file(
OpenSRF::Utils::SettingsClient
->new
->config_value( dirs => 'xsl' ).
"/CNBrowse2HTML.xsl"
);
$cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
%qualifier_map = %{$supercat
->request("open-ils.supercat.biblio.search_aliases")
->gather(1)};
my %attribute_desc = (
site => 'Evergreen Site Code (shortname)',
sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
dir => 'Sort direction (asc|desc)',
available => 'Filter to available (true|false)',
);
# Append the non-search-alias attributes to the qualifier map
foreach ( qw/
available
ascending
descending
sort
format
before
after
statuses
locations
site
depth
lasso
offset
limit
preferred_language
preferred_language_weight
preferred_language_multiplier
/) {
$qualifier_map{'eg'}{$_}{'index'} = $_;
if (exists $attribute_desc{$_}) {
$qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
} else {
$qualifier_map{'eg'}{$_}{'title'} = $_;
}
}
my $list = $supercat
->request("open-ils.supercat.record.formats")
->gather(1);
$list = [ map { (keys %$_)[0] } @$list ];
push @$list, 'htmlholdings','html', 'marctxt', 'ris';
for my $browse_axis ( qw/title author subject topic series item-age/ ) {
for my $record_browse_format ( @$list ) {
{
my $__f = $record_browse_format;
my $__a = $browse_axis;
$browse_types{$__a}{$__f} = sub {
my $record_list = shift;
my $prev = shift;
my $next = shift;
my $real_format = shift || $__f;
my $unapi = shift;
my $base = shift;
my $site = shift;
$log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
$feed->root( "$base/../" );
$feed->lib( $site );
$feed->link( next => $next => $feed->type );
$feed->link( previous => $prev => $feed->type );
return (
"Content-type: ". $feed->type ."; charset=utf-8\n\n",
$feed->toString
);
};
}
}
}
my $auth_axes = $supercat
->request("open-ils.supercat.authority.browse_axis_list")
->gather(1);
for my $axis ( @$auth_axes ) {
my $basic_axis = 'authority.' . $axis;
for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
{
my $__f = 'marcxml';
my $__a = $browse_axis;
$browse_types{$__a}{$__f} = sub {
my $record_list = shift;
my $prev = shift;
my $next = shift;
my $real_format = shift || $__f;
my $unapi = shift;
my $base = shift;
my $site = shift;
$log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
$feed->root( "$base/../" );
$feed->link( next => $next => $feed->type );
$feed->link( previous => $prev => $feed->type );
return (
"Content-type: ". $feed->type ."; charset=utf-8\n\n",
$feed->toString
);
};
}
}
}
return Apache2::Const::OK;
}
sub check_child_init() {
if (!defined $supercat || !defined $actor || !defined $search) {
# For some reason one (or more) of our appsessions is missing....
# So init!
child_init();
}
}
=head2 parse_feed_type($type)
Determines whether and how a given feed type needs to be "fleshed out"
with holdings information.
The feed type could end with the string "-full", in which case we want
to return call numbers, copies, and URIS.
Or the feed type could end with "-uris", in which case we want to return
call numbers and URIS.
Otherwise, we won't return any holdings.
=cut
sub parse_feed_type {
my $type = shift || '';
if ($type =~ /-full$/o) {
return 1;
}
if ($type =~ /-uris$/o) {
return 2;
}
# Otherwise, we'll return just the facts, ma'am
return 0;
}
=head2 supercat_format($format_hashref, $format_type)
Given a reference to a hash containing the namespace_uri,
docs, and schema location attributes for a set of formats,
generate the XML description required by the supercat service.
We derive the base type from the format type so that we do not
have to populate the hash with redundant information.
=cut
sub supercat_format {
my $h = shift;
my $type = shift;
(my $base_type = $type) =~ s/(-full|-uris)$//o;
my $format = "$typeapplication/xml";
for my $part ( qw/namespace_uri docs schema_location/ ) {
$format .= "<$part>$$h{$base_type}{$part}$part>"
if ($$h{$base_type}{$part});
}
$format .= '';
return $format;
}
=head2 unapi_format($format_hashref, $format_type)
Given a reference to a hash containing the namespace_uri,
docs, and schema location attributes for a set of formats,
generate the XML description required by the supercat service.
We derive the base type from the format type so that we do not
have to populate the hash with redundant information.
=cut
sub unapi_format {
my $h = shift;
my $type = shift;
(my $base_type = $type) =~ s/(-full|-uris)$//o;
my $format = "();
}
return $str . $value . "\n";
} @$list;
}
return;
}
# Return key/value pairs suitable for feeding into CGI::header()
sub extra_headers_per_type_to_cgi {
my ($type) = @_;
if (my $list = $extra_header_action_per_type{$type}) {
return map {
my $key = (keys(%$_))[0];
my $value = (values(%$_))[0];
if (ref $value eq 'CODE') {
$value = $value->();
}
return $key => $value;
} @$list;
}
return;
}
sub oisbn {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
(my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
my $list = $supercat
->request("open-ils.supercat.oisbn", $isbn)
->gather(1);
print "Content-type: application/xml; charset=utf-8\n\n";
print "\n";
unless (exists $$list{metarecord}) {
print '';
return Apache2::Const::OK;
}
print "\n";
for ( keys %{ $$list{record_list} } ) {
(my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
print " $o\n"
}
print "\n";
return Apache2::Const::OK;
}
sub unapi2 {
my $apache = shift;
my $u2 = shift;
my $format = shift;
my $ctype = 'application/xml';
# Only bre and biblio_record_entry_feed have tranforms, but we'll ignore that for now
if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/ and $format ne 'xml') {
# XXX set $ctype to something else
}
print "Content-type: $ctype; charset=utf-8\n\n";
print "\n";
print $U->entityize(
$supercat->request("open-ils.supercat.u2", $u2->toURI, $format)
->gather(1)
);
return Apache2::Const::OK;
}
sub unapi2_formats {
my $apache = shift;
my $u2 = shift;
print "Content-type: application/xml; charset=utf-8\n\n";
print "\n";
my $id = $u2->toURI;
if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/) {
# TODO: if/when unapi.bre_output_layout becomes something
# that actually changes, the hard-coding here should be
# replaced
print <
FORMATS
} else {
print <
FORMATS
}
return Apache2::Const::OK;
}
sub unapi {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'unapi', $url)[0];
my $base = (split 'unapi', $url)[0] . 'unapi';
my $uri = $cgi->param('id') || '';
my $format = $cgi->param('format') || '';
(my $base_format = $format) =~ s/(-full|-uris)$//o;
my $u2uri = OpenILS::Utils::TagURI->new($uri);
if ($u2uri->version > 1) {
if ($format) {
return unapi2($apache, $u2uri, $format);
} else {
return unapi2_formats($apache, $u2uri);
}
}
my $host = $cgi->virtual_host || $cgi->server_name;
my $skin = $cgi->param('skin') || 'default';
my $locale = $cgi->param('locale') || 'en-US';
# Enable localized results of copy status, etc
$supercat->session_locale($locale);
my $flesh_feed = parse_feed_type($format);
($base_format = $format) =~ s/(-full|-uris)$//o;
my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
my $body = "Content-type: application/xml; charset=utf-8\n\n";
if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
$id = $2;
$paging = $3;
($lib,$depth) = split('/', $4);
$type = 'metarecord' if ($1 =~ /^m/o);
$type = 'authority' if ($1 =~ /^authority/o);
}
if (!$format) {
if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
my $list = $supercat
->request("open-ils.supercat.$type.formats")
->gather(1);
if ($type eq 'record' or $type eq 'isbn') {
$body .= <<" FORMATS";
FORMATS
} elsif ($type eq 'metarecord') {
$body .= <<" FORMATS";
FORMATS
} else {
$body .= <<" FORMATS";
FORMATS
}
for my $h (@$list) {
my ($type) = keys %$h;
$body .= unapi_format($h, $type);
if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
$body .= unapi_format($h, "$type-full");
$body .= unapi_format($h, "$type-uris");
}
}
$body .= "\n";
} else {
my $list = $supercat
->request("open-ils.supercat.$type.formats")
->gather(1);
push @$list,
@{ $supercat
->request("open-ils.supercat.metarecord.formats")
->gather(1);
};
my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
$list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
$body .= <<" FORMATS";
FORMATS
for my $h (@$list) {
my ($type) = keys %$h;
$body .= "\t" . unapi_format($h, $type);
if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
$body .= "\t" . unapi_format($h, "$type-full");
$body .= "\t" . unapi_format($h, "$type-uris");
}
}
$body .= "\n";
}
print $body;
return Apache2::Const::OK;
}
my $scheme;
if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
$scheme = $1;
$id = $2;
$paging = $3;
($lib,$depth) = split('/', $4);
$type = 'record';
$type = 'metarecord' if ($scheme =~ /^metabib/o);
$type = 'isbn' if ($scheme =~ /^isbn/o);
$type = 'acp' if ($scheme =~ /^asset-copy/o);
$type = 'acn' if ($scheme =~ /^asset-call_number/o);
$type = 'auri' if ($scheme =~ /^asset-uri/o);
$type = 'authority' if ($scheme =~ /^authority/o);
$command = 'retrieve';
$command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
$command = 'browse' if ($scheme =~ /^authority/);
}
if ($paging) {
$paging = [split ',', $paging];
} else {
$paging = [];
}
if (!$lib || $lib eq '-') {
$lib = $actor->request(
'open-ils.actor.org_unit_list.search' => parent_ou => undef
)->gather(1)->[0]->shortname;
}
my ($lib_object,$lib_id,$ou_types,$lib_depth);
if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
$lib_object = $actor->request(
'open-ils.actor.org_unit_list.search' => shortname => $lib
)->gather(1)->[0];
$lib_id = $lib_object->id;
$ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
$lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
}
if ($command eq 'browse') {
print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
return 302;
}
if ($type eq 'isbn') {
my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
if (!@$rec) {
# Escape user input before display
$command = CGI::escapeHTML($command);
$id = CGI::escapeHTML($id);
$type = CGI::escapeHTML($type);
$format = CGI::escapeHTML(decode_utf8($format));
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 404, <<" HTML");
Type [$type] with id [$id] not found!
Sorry, we couldn't $command a $type with the id of $id in format $format.
HTML
return 404;
}
$id = $rec->[0]->id;
$type = 'record';
}
if ( !grep
{ (keys(%$_))[0] eq $base_format }
@{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
and !grep
{ $_ eq $base_format }
qw/opac html htmlholdings marctxt ris holdings_xml/
) {
# Escape user input before display
$format = CGI::escapeHTML($format);
$type = CGI::escapeHTML($type);
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 406, <<" HTML");
Invalid format [$format] for type [$type]!
Sorry, format $format is not valid for type $type.
HTML
return 406;
}
if ($format eq 'opac') {
print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
if ($type eq 'metarecord');
print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
if ($type eq 'record');
return 302;
} elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
my $feed = create_record_feed(
$type,
$format => [ $id ],
$base,
$lib,
$depth,
$flesh_feed,
$paging
);
if (!$feed->count) {
# Escape user input before display
$command = CGI::escapeHTML($command);
$id = CGI::escapeHTML($id);
$type = CGI::escapeHTML($type);
$format = CGI::escapeHTML(decode_utf8($format));
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 404, <<" HTML");
Type [$type] with id [$id] not found!
Sorry, we couldn't $command a $type with the id of $id in format $format.
HTML
return 404;
}
$feed->root($root);
$feed->creator($host);
$feed->update_ts();
$feed->link( unapi => $base) if ($flesh_feed);
print "Content-type: ". $feed->type ."; charset=utf-8\n";
print $_ for extra_headers_per_type_to_string($type);
print "\n", $feed->toString, "\n";
return Apache2::Const::OK;
}
my $method = "open-ils.supercat.$type.$base_format.$command";
my @params = ($id);
push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
# for acn, acp, etc, the "lib" pathinfo position isn't useful.
# however, we can have it carry extra options like no_record! (comma separated)
push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
my $req = $supercat->request($method,@params);
my $data = $req->gather();
if ($req->failed || !$data) {
# Escape user input before display
$command = CGI::escapeHTML($command);
$id = CGI::escapeHTML($id);
$type = CGI::escapeHTML($type);
$format = CGI::escapeHTML(decode_utf8($format));
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 404, <<" HTML");
$type $id not found!
Sorry, we couldn't $command a $type with the id of $id in format $format.
HTML
return 404;
}
print "Content-type: application/xml; charset=utf-8\n\n";
# holdings_xml format comes back to us without an XML declaration
# and without being entityized; fix that here
if ($base_format eq 'holdings_xml') {
print "\n";
print $U->entityize($data);
while (my $c = $req->recv) {
print $U->entityize($c->content);
}
} else {
print $data;
}
return Apache2::Const::OK;
}
sub supercat {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'supercat', $url)[0];
my $base = (split 'supercat', $url)[0] . 'supercat';
my $unapi = (split 'supercat', $url)[0] . 'unapi';
my $host = $cgi->virtual_host || $cgi->server_name;
my $path = $cgi->path_info;
my ($id,$type,$format,$command) = reverse split '/', $path;
my $flesh_feed = parse_feed_type($format);
(my $base_format = $format) =~ s/(-full|-uris)$//o;
my $skin = $cgi->param('skin') || 'default';
my $locale = $cgi->param('locale') || 'en-US';
# Enable localized results of copy status, etc
$supercat->session_locale($locale);
if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
print "Content-type: application/xml; charset=utf-8\n";
if ($1) {
my $list = $supercat
->request("open-ils.supercat.$1.formats")
->gather(1);
print "\n";
print "
opac
text/html
";
if ($1 eq 'record' or $1 eq 'isbn') {
print "
htmlholdings
text/html
html
text/html
htmlholdings-full
text/html
html-full
text/html
marctxt
text/plain
ris
text/plain
";
}
for my $h (@$list) {
my ($type) = keys %$h;
print supercat_format($h, $type);
if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
print supercat_format($h, "$type-full");
print supercat_format($h, "$type-uris");
}
}
print "\n";
return Apache2::Const::OK;
}
my $list = $supercat
->request("open-ils.supercat.record.formats")
->gather(1);
push @$list,
@{ $supercat
->request("open-ils.supercat.metarecord.formats")
->gather(1);
};
my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
$list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
print "\n
opac
text/html
htmlholdings
text/html
html
text/html
htmlholdings-full
text/html
html-full
text/html
marctxt
text/plain
ris
text/plain
";
for my $h (@$list) {
my ($type) = keys %$h;
print supercat_format($h, $type);
if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
print supercat_format($h, "$type-full");
print supercat_format($h, "$type-uris");
}
}
print "\n";
return Apache2::Const::OK;
}
if ($format eq 'opac') {
print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
if ($type eq 'metarecord');
print "Location: /eg/opac/record/$id\n\n"
if ($type eq 'record');
return 302;
} elsif ($base_format eq 'marc21') {
my $ret = 200;
try {
my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
print "Content-type: application/octet-stream\n";
print $_ for extra_headers_per_type_to_string($base_format);
print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
} otherwise {
warn shift();
# Escape user input before display
$id = CGI::escapeHTML($id);
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 404, <<" HTML");
ERROR
Couldn't fetch $id as MARC21.
HTML
$ret = 404;
};
return Apache2::Const::OK;
} elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
my $feed = create_record_feed(
$type,
$format => [ $id ],
undef, undef, undef,
$flesh_feed
);
$feed->root($root);
$feed->creator($host);
$feed->update_ts();
$feed->link( unapi => $base) if ($flesh_feed);
print "Content-type: ". $feed->type ."; charset=utf-8\n";
print $_ for extra_headers_per_type_to_string($type);
print "\n", $feed->toString, "\n";
return Apache2::Const::OK;
}
my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
$req->wait_complete;
if ($req->failed) {
# Escape user input before display
$command = CGI::escapeHTML($command);
$id = CGI::escapeHTML($id);
$type = CGI::escapeHTML($type);
$format = CGI::escapeHTML(decode_utf8($format));
print "Content-type: text/html; charset=utf-8\n\n";
$apache->custom_response( 404, <<" HTML");
$type $id not found!
Sorry, we couldn't $command a $type with the id of $id in format $format.
HTML
return 404;
}
print "Content-type: application/xml; charset=utf-8\n\n";
print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
return Apache2::Const::OK;
}
sub bookbag_feed {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'feed', $url)[0] . '/';
my $base = (split 'bookbag', $url)[0] . '/bookbag';
my $unapi = (split 'feed', $url)[0] . '/unapi';
my $skin = $cgi->param('skin') || 'default';
my $locale = $cgi->param('locale') || 'en-US';
my $org = $cgi->param('searchOrg');
# Enable localized results of copy status, etc
$supercat->session_locale($locale);
my $org_unit = get_ou($org);
my $scope = "l=" . $org_unit->[0]->id . "&";
$root =~ s{(?path_info;
#warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
my ($id,$type) = reverse split '/', $path;
my $flesh_feed = parse_feed_type($type);
my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
return Apache2::Const::NOT_FOUND unless($bucket);
my $bucket_tag = "tag:$host,$year:record_bucket/$id";
if (lc($type) eq 'opac') {
print "Location: /eg/opac/results?bookbag=$id\n\n";
return 302;
}
# last created first
my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
my $feed = create_record_feed(
'record',
$type,
[ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
$unapi,
$org_unit->[0]->shortname,
undef,
$flesh_feed
);
$feed->root($root);
$feed->id($bucket_tag);
$feed->title($bucket->name);
$feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
$feed->creator($host);
$feed->update_ts();
$feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
$feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
$feed->link(opac => $base . "/opac/$id" => 'text/html');
$feed->link(OPAC => $base . "/opac/$id" => 'text/html');
$feed->link(html => $base . "/html-full/$id" => 'text/html');
$feed->link(unapi => $unapi);
print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
print $feed->toString . "\n";
return Apache2::Const::OK;
}
sub changes_feed {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'feed', $url)[0];
my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
my $unapi = (split 'feed', $url)[0] . 'unapi';
my $skin = $cgi->param('skin') || 'default';
my $locale = $cgi->param('locale') || 'en-US';
my $org = $cgi->param('searchOrg');
# Enable localized results of copy status, etc
$supercat->session_locale($locale);
my $org_unit = get_ou($org);
my $scope = "l=" . $org_unit->[0]->id . "&";
my $path = $cgi->path_info;
#warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
$path =~ s/^\/(?:feed\/)?freshmeat\///og;
my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
my $flesh_feed = parse_feed_type($type);
$limit ||= 10;
$limit = 10 if $limit !~ /^\d+$/;
my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
if (lc($type) eq 'opac') {
print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
return 302;
}
my $search = 'record';
if ($rtype eq 'authority') {
$search = 'authority';
}
my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
$feed->root($root);
if ($date) {
$feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
} else {
$feed->title("$limit most recent $rtype ${axis}s");
}
$feed->creator($host);
$feed->update_ts();
$feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
$feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
$feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
$feed->link(unapi => $unapi);
$feed->link(
OPAC =>
"http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
'text/html'
);
print "Content-type: ". $feed->type ."; charset=utf-8\n";
print $_ for extra_headers_per_type_to_string($type);
print "\n", $feed->toString, "\n";
return Apache2::Const::OK;
}
sub opensearch_osd {
my $version = shift;
my $lib = shift;
my $class = shift;
my $base = shift;
my $host = shift;
if ($version eq '1.0') {
print <
$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}
http://a9.com/-/spec/opensearchrss/1.0/
$lib
Search $lib
Search the $lib OPAC by $class.
$lib book library
harry+potter
Mike Rylander for GPLS/PINES
feedback\@open-ils.org
open
false
OSD
} else {
print <
$lib
Search the $lib OPAC by $class.
$lib book library
Search $lib
Mike Rylander for GPLS/PINES
feedback\@open-ils.org
open
false
en-US
UTF-8
UTF-8
OSD
}
return Apache2::Const::OK;
}
sub opensearch_feed {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'opensearch', $url)[0];
my $base = (split 'opensearch', $url)[0] . 'opensearch';
my $unapi = (split 'opensearch', $url)[0] . 'unapi';
my $path = $cgi->path_info;
#warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
my $version = $1;
my $lib = uc($2);
my $class = $3;
if (!$lib || $lib eq '-') {
$lib = $actor->request(
'open-ils.actor.org_unit_list.search' => parent_ou => undef
)->gather(1)->[0]->shortname;
}
if ($class eq '-') {
$class = 'keyword';
}
return opensearch_osd($version, $lib, $class, $base, $host);
}
my $page = $cgi->param('startPage') || 1;
my $offset = $cgi->param('startIndex') || 1;
my $limit = $cgi->param('count') || 10;
$page = 1 if ($page !~ /^\d+$/);
$offset = 1 if ($offset !~ /^\d+$/);
$limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
if ($page > 1) {
$offset = ($page - 1) * $limit;
} else {
$offset -= 1;
}
my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
(undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
$lang = $cgi->param('searchLang') if $cgi->param('searchLang');
$lang = '' if ($lang eq '*');
$sort = $cgi->param('searchSort') if $cgi->param('searchSort');
$sort ||= '';
$sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
$sortdir ||= '';
$terms .= " " if ($terms && $cgi->param('searchTerms'));
$terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
$class = $cgi->param('searchClass') if $cgi->param('searchClass');
$class ||= '-';
$type = $cgi->param('responseType') if $cgi->param('responseType');
$type ||= '-';
$org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
$org ||= '-';
my $kwt = $cgi->param('kw');
my $tit = $cgi->param('ti');
my $aut = $cgi->param('au');
my $sut = $cgi->param('su');
my $set = $cgi->param('se');
$terms .= " " if ($terms && $kwt);
$terms .= "keyword: $kwt" if ($kwt);
$terms .= " " if ($terms && $tit);
$terms .= "title: $tit" if ($tit);
$terms .= " " if ($terms && $aut);
$terms .= "author: $aut" if ($aut);
$terms .= " " if ($terms && $sut);
$terms .= "subject: $sut" if ($sut);
$terms .= " " if ($terms && $set);
$terms .= "series: $set" if ($set);
if ($version eq '1.0') {
$type = 'rss2';
} elsif ($type eq '-') {
$type = 'atom';
}
my $flesh_feed = parse_feed_type($type);
$terms = decode_utf8($terms);
$lang = 'eng' if ($lang eq 'en-US');
$log->debug("OpenSearch terms: $terms");
my $org_unit = get_ou($org);
my $safe_terms = $terms;
# XXX Apostrophes used to break search, but no longer do. The following
# XXX line breaks phrase searching in OpenSearch, and should be removed.
$safe_terms =~ s{'}{ }go;
my $query_terms = 'site('.$org_unit->[0]->shortname.") $safe_terms";
$query_terms = "sort($sort) $query_terms" if ($sort);
$query_terms = "language($lang) $query_terms" if ($lang);
$query_terms = "#$sortdir $query_terms" if ($sortdir);
my $recs = $search->request(
'open-ils.search.biblio.multiclass.query' => {
offset => $offset,
limit => $limit
} => $query_terms => 1
)->gather(1);
$log->debug("Hits for [$terms]: $recs->{count}");
my $feed = create_record_feed(
'record',
$type,
[ map { $_->[0] } @{$recs->{ids}} ],
$unapi,
$org,
undef,
$flesh_feed
);
$log->debug("Feed created...");
$feed->root($root);
$feed->lib($org);
$feed->search($safe_terms);
$feed->class($class);
$feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
$feed->creator($host);
$feed->update_ts();
$feed->_create_node(
$feed->{item_xpath},
'http://a9.com/-/spec/opensearch/1.1/',
'totalResults',
$recs->{count},
);
$feed->_create_node(
$feed->{item_xpath},
'http://a9.com/-/spec/opensearch/1.1/',
'startIndex',
$offset + 1,
);
$feed->_create_node(
$feed->{item_xpath},
'http://a9.com/-/spec/opensearch/1.1/',
'itemsPerPage',
$limit,
);
$log->debug("...basic feed data added...");
$feed->link(
next =>
$base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
'application/opensearch+xml'
) if ($offset + $limit < $recs->{count});
$feed->link(
previous =>
$base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
'application/opensearch+xml'
) if ($offset);
$feed->link(
self =>
$base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
'application/opensearch+xml'
);
$feed->link(
alternate =>
$base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
'application/rss+xml'
);
$feed->link(
atom =>
$base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
'application/atom+xml'
);
$feed->link(
'html' =>
$base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
'text/html'
);
$feed->link(
'html-full' =>
$base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
'text/html'
);
$feed->link( 'unapi-server' => $unapi);
$log->debug("...feed links added...");
# $feed->link(
# opac =>
# $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
# join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
# 'text/html'
# );
#print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
print $cgi->header(
-type => $feed->type, -charset => 'UTF-8',
extra_headers_per_type_to_cgi($type)
), $feed->toString, "\n";
$log->debug("...and feed returned.");
return Apache2::Const::OK;
}
sub create_record_feed {
my $search = shift;
my $type = shift;
my $records = shift;
my $unapi = shift;
my $lib = uc(shift()) || '-';
my $depth = shift;
my $flesh = shift;
my $paging = shift;
my $cgi = new CGI;
my $base = $cgi->url;
my $host = $cgi->virtual_host || $cgi->server_name;
my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
$year += 1900;
$month += 1;
my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
$type =~ s/(-full|-uris)$//o;
my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
$feed->base($base) if ($flesh);
$feed->unapi($unapi) if ($flesh);
$type = 'atom' if ($type eq 'html');
$type = 'marcxml' if
$type eq 'htmlholdings' or
$type eq 'marctxt' or
$type eq 'ris' or
$type eq 'marc21'; # kludgy since it isn't an XML format, but needed
#$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
my $count = 0;
for my $record (@$records) {
next unless($record);
#my $rec = $record->id;
my $rec = $record;
my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
$item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
$item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
$item_tag .= "/$depth" if (defined($depth));
$item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
my $xml = $supercat->request(
"open-ils.supercat.$search.$type.retrieve",
$rec
)->gather(1);
next unless $xml;
my $node = $feed->add_item($xml);
next unless $node;
$xml = '';
if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
while ( !$r->complete ) {
$xml .= join('', map {$_->content} $r->recv);
}
$xml .= join('', map {$_->content} $r->recv);
$node->add_holdings($xml);
}
$node->id($item_tag);
#$node->update_ts(cleanse_ISO8601($record->edit_date));
$node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
$node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
$node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
$node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
$node->link('unapi-id' => $item_tag) if ($flesh);
}
return $feed;
}
sub string_browse {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'browse', $url)[0];
my $base = (split 'browse', $url)[0] . 'browse';
my $unapi = (split 'browse', $url)[0] . 'unapi';
my $path = $cgi->path_info;
$path =~ s/^\///og;
my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
#warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
my $status = [$cgi->param('status')];
my $cpLoc = [$cgi->param('copyLocation')];
$site ||= $cgi->param('searchOrg');
$page ||= $cgi->param('startPage') || 0;
$page_size ||= $cgi->param('count') || 9;
$thesauruses //= '';
$thesauruses =~ s/\s//g;
# protect against cats bouncing on the comma key...
$thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
$page = 0 if ($page !~ /^-?\d+$/);
$page_size = 9 if $page_size !~ /^\d+$/;
my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
warn "something's wrong...";
warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
return undef;
}
$string = decode_utf8($string);
$string =~ s/\+/ /go;
$string =~ s/'//go;
my $tree;
if ($axis =~ /^authority/) {
my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
my $method = "open-ils.supercat.authority.browse_center.by_axis";
$method .= ".refs" if $refs;
$tree = $supercat->request(
$method,
$realaxis,
$string,
$page,
$page_size,
$thesauruses
)->gather(1);
} else {
$tree = $supercat->request(
"open-ils.supercat.$axis.browse",
$string,
$site,
$page_size,
$page,
$status,
$cpLoc
)->gather(1);
}
(my $norm_format = $format) =~ s/(-full|-uris)$//o;
my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
print $header.$content;
return Apache2::Const::OK;
}
sub string_startwith {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'startwith', $url)[0];
my $base = (split 'startwith', $url)[0] . 'startwith';
my $unapi = (split 'startwith', $url)[0] . 'unapi';
my $path = $cgi->path_info;
$path =~ s/^\///og;
my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
#warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
my $status = [$cgi->param('status')];
my $cpLoc = [$cgi->param('copyLocation')];
$site ||= $cgi->param('searchOrg');
$page ||= $cgi->param('startPage') || 0;
$page_size ||= $cgi->param('count') || 9;
$thesauruses //= '';
$thesauruses =~ s/\s//g;
# protect against cats bouncing on the comma key...
$thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
$page = 0 if ($page !~ /^-?\d+$/);
$page_size = 9 if $page_size !~ /^\d+$/;
my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
warn "something's wrong...";
warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
return undef;
}
$string = decode_utf8($string);
$string =~ s/\+/ /go;
$string =~ s/'//go;
my $tree;
if ($axis =~ /^authority/) {
my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
my $method = "open-ils.supercat.authority.browse_top.by_axis";
$method .= ".refs" if $refs;
$tree = $supercat->request(
$method,
$realaxis,
$string,
$page,
$page_size,
$thesauruses
)->gather(1);
} else {
$tree = $supercat->request(
"open-ils.supercat.$axis.startwith",
$string,
$site,
$page_size,
$page,
$status,
$cpLoc
)->gather(1);
}
(my $norm_format = $format) =~ s/(-full|-uris)$//o;
my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
print $header.$content;
return Apache2::Const::OK;
}
sub item_age_browse {
my $apache = shift;
return Apache2::Const::DECLINED if (-e $apache->filename);
check_child_init();
my $cgi = new CGI;
my $year = (gmtime())[5] + 1900;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $url = $cgi->url(-path_info=>$add_path);
my $root = (split 'browse', $url)[0];
my $base = (split 'browse', $url)[0] . 'browse';
my $unapi = (split 'browse', $url)[0] . 'unapi';
my $path = $cgi->path_info;
$path =~ s/^\///og;
my ($format,$axis,$site,$page,$page_size) = split '/', $path;
#warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
unless ($axis eq 'item-age') {
warn "something's wrong...";
warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
return undef;
}
my $status = [$cgi->param('status')];
my $cpLoc = [$cgi->param('copyLocation')];
$site ||= $cgi->param('searchOrg') || '-';
$page ||= $cgi->param('startPage') || 1;
$page_size ||= $cgi->param('count') || 10;
$page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
$page_size = 10 if $page_size !~ /^\d+$/;
my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
my $recs = $supercat->request(
"open-ils.supercat.new_book_list",
$site,
$page_size,
$page,
$status,
$cpLoc
)->gather(1);
(my $norm_format = $format) =~ s/(-full|-uris)$//o;
my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
print $header.$content;
return Apache2::Const::OK;
}
our %qualifier_ids = (
eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
dc => 'info:srw/cql-context-set/1/dc-v1.1',
bib => 'info:srw/cql-context-set/1/bib-v1.0',
srw => ''
);
# Our authority search options are currently pretty impoverished;
# just right-truncated string match on a few categories, or by
# ID number
our %nested_auth_qualifier_map = (
eg => {
id => { index => 'id', title => 'Record number'},
name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
title => { index => 'title', title => 'Uniform title'},
subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
topic => { index => 'topic', title => 'Topical term'},
},
);
my $base_explain = <
MARC21Slim (marcxml)
10
eg
keyword
all
marcxml
marcxml
50
relevant
stem
fuzzy
word
XML
my $ex_doc;
sub sru_search {
my $cgi = new CGI;
check_child_init();
my $req = SRU::Request->newFromCGI( $cgi );
my $resp = SRU::Response->newFromRequest( $req );
# Find the org_unit shortname, if passed as part of the URL
# http://example.com/opac/extras/sru/SHORTNAME
my $url = $cgi->path_info;
my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
if ( $resp->type eq 'searchRetrieve' ) {
# Older versions of Debian packages returned terms to us double-encoded,
# so we had to forcefully double-decode them a second time with
# an outer decode('utf8', $string) call; this seems to be resolved with
# Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
my $cql_query = decode_utf8($req->query);
my $search_string = decode_utf8($req->cql->toEvergreen);
# Ensure the search string overrides the default site
if ($shortname and $search_string !~ m#site:#) {
$search_string .= " site:$shortname";
}
my $offset = $req->startRecord;
$offset-- if ($offset);
$offset ||= 0;
my $limit = $req->maximumRecords;
$limit ||= 10;
$log->info("SRU search string [$cql_query] converted to [$search_string]\n");
if (!$shortname || $shortname eq '-') {
my $search_org = get_ou($shortname);
$shortname = $search_org->[0]->shortname;
}
my $recs = $search->request(
'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
)->gather(1);
my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
foreach my $rec (@{$recs->{ids}}) {
my $rec_id = shift @$rec;
my $data = $cstore->request(
'open-ils.cstore.json_query' => {
from => [
'unapi.bre', $rec_id,
'marcxml', 'record',
($holdings) ? '{holdings_xml,acp}' : '{}',
$shortname
]
}
)->gather(1);
try {
my $marcxml = XML::LibXML->load_xml( string => $data->{'unapi.bre'} );
# process element, if any
my @copies;
for my $node ($marcxml->getElementsByTagName('holdings')) {
for my $volume ($node->getElementsByTagName('volume')) {
my $prefix = $volume->getChildrenByTagName('call_number_prefix')->[0]->getAttribute('label');
my $suffix = $volume->getChildrenByTagName('call_number_suffix')->[0]->getAttribute('label');
my $cn = $volume->getAttribute('label');
my $owning_lib = $volume->getAttribute('lib');
for my $copy ($volume->getElementsByTagName('copy')) {
push @copies, {
a => $copy->getChildrenByTagName('location')->[0]->textContent,
b => $owning_lib,
c => $cn,
d => $copy->getChildrenByTagName('circ_lib')->[0]->getAttribute('shortname'),
g => $copy->getAttribute('barcode'),
k => $prefix,
m => $suffix,
n => $copy->getChildrenByTagName('status')->[0]->textContent
};
}
}
# remove element
$node->parentNode->removeChild($node);
}
my $marc = MARC::Record->new_from_xml($marcxml->toString(), 'UTF8', 'XML');
# Force record leader to 'a' as our data is always UTF8
# Avoids marc8_to_utf8 from being invoked with horrible results
# on the off-chance the record leader isn't correct
my $ldr = $marc->leader;
substr($ldr, 9, 1, 'a');
$marc->leader($ldr);
# Expects the record ID in the 001
$marc->delete_field($_) for ($marc->field('001'));
if (!$marc->field('001')) {
$marc->insert_fields_ordered(
MARC::Field->new( '001', $rec_id )
);
}
$marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
for my $copy (@copies) {
$marc->insert_fields_ordered(
MARC::Field->new(
'852', '4', '',
a => $copy->{a},
b => $copy->{b},
c => $copy->{c},
d => $copy->{d},
g => $copy->{g},
($copy->{k} ? (k => $copy->{k}) : ()),
($copy->{m} ? (m => $copy->{m}) : ()),
n => $copy->{n}
)
);
}
my $output = $marc->as_xml_record();
$output =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
$resp->addRecord(
SRU::Response::Record->new(
recordSchema => 'info:srw/schema/1/marcxml-v1.1',
recordData => $output,
recordPosition => ++$offset
)
);
} catch Error with {
$log->error("Failed to process record for SRU search");
}
}
$resp->numberOfRecords($recs->{count});
} elsif ( $resp->type eq 'explain' ) {
return_sru_explain($cgi, $req, $resp, \$ex_doc,
undef,
\%OpenILS::WWW::SuperCat::qualifier_ids
);
$resp->record(
SRU::Response::Record->new(
recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
recordData => $ex_doc
)
);
}
print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
print $U->entityize($resp->asXML) . "\n";
return Apache2::Const::OK;
}
{
package CQL::BooleanNode;
sub toEvergreen {
my $self = shift;
my $left = $self->left();
my $right = $self->right();
my $leftStr = $left->toEvergreen;
my $rightStr = $right->toEvergreen();
my $op = '||' if uc $self->op() eq 'OR';
$op ||= '&&';
return "$leftStr $op $rightStr";
}
sub toEvergreenAuth {
return toEvergreen(shift);
}
package CQL::TermNode;
sub toEvergreen {
my $self = shift;
my $qualifier = $self->getQualifier();
my $term = $self->getTerm();
my $relation = $self->getRelation();
my $query;
if ( $qualifier ) {
my ($qset, $qname) = split(/\./, $qualifier);
# Per http://www.loc.gov/standards/sru/specs/cql.html
# "All parts of CQL are case insensitive [...] If any case insensitive
# part of CQL is specified with both upper and lower case, it is for
# aesthetic purposes only."
# So fold the qualifier and relation to lower case
$qset = lc($qset);
$qname = lc($qname);
if ( exists($qualifier_map{$qset}{$qname}) ) {
$qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
$log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
}
my @modifiers = $relation->getModifiers();
my $base = $relation->getBase();
if ( grep { $base eq $_ } qw/= scr exact all/ ) {
my $quote_it = 1;
foreach my $m ( @modifiers ) {
if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
$quote_it = 0;
last;
}
}
$quote_it = 0 if ( $base eq 'all' );
$term = maybeQuote($term) if $quote_it;
} else {
croak( "Evergreen doesn't support the $base relations" );
}
} else {
$qualifier = "kw";
}
return "$qualifier:$term";
}
sub toEvergreenAuth {
my $self = shift;
my $qualifier = $self->getQualifier();
my $term = $self->getTerm();
my $relation = $self->getRelation();
my $query;
if ( $qualifier ) {
my ($qset, $qname) = split(/\./, $qualifier);
if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
$qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
$log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
}
}
return { qualifier => $qualifier, term => $term };
}
}
my $auth_ex_doc;
sub sru_auth_search {
my $cgi = new CGI;
check_child_init();
my $req = SRU::Request->newFromCGI( $cgi );
my $resp = SRU::Response->newFromRequest( $req );
if ( $resp->type eq 'searchRetrieve' ) {
return_auth_response($cgi, $req, $resp);
} elsif ( $resp->type eq 'explain' ) {
return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
\%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
\%OpenILS::WWW::SuperCat::qualifier_ids
);
}
print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
print $U->entityize($resp->asXML) . "\n";
return Apache2::Const::OK;
}
sub explain_header {
my $cgi = shift;
my $host = $cgi->virtual_host || $cgi->server_name;
my $add_path = 0;
if ( $cgi->server_software !~ m|^Apache/2.2| ) {
my $rel_name = $cgi->url(-relative=>1);
$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
}
my $base = $cgi->url(-base=>1);
my $url = $cgi->url(-path_info=>$add_path);
$url =~ s/^$base\///o;
my $doc = $parser->parse_string($base_explain);
my $e = $doc->documentElement;
$e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
$e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
$e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
return ($doc, $e);
}
sub return_sru_explain {
my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
$index_map ||= \%qualifier_map;
if (!$$explain) {
my ($doc, $e) = explain_header($cgi);
for my $name ( keys %{$index_map} ) {
my $identifier = $qualifier_ids->{ $name };
next unless $identifier;
my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
$set_node->setAttribute( identifier => $identifier );
$set_node->setAttribute( name => $name );
$e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
for my $index ( sort keys %{$index_map->{$name}} ) {
my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
$map_node->appendChild( $name_node );
my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
$index_node->appendChild( $title_node );
$index_node->appendChild( $map_node );
$index_node->setAttribute( id => "$name.$index" );
$title_node->appendText($index_map->{$name}{$index}{'title'});
$name_node->setAttribute( set => $name );
$name_node->appendText($index_map->{$name}{$index}{'index'});
$e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
}
}
$$explain = $e->toString;
}
$resp->record(
SRU::Response::Record->new(
recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
recordData => $$explain
)
);
}
sub return_auth_response {
my ($cgi, $req, $resp) = @_;
my $cql_query = decode_utf8($req->query);
my $search = $req->cql->toEvergreenAuth;
my $qualifier = decode_utf8($search->{qualifier});
my $term = decode_utf8($search->{term});
$log->info("SRU NAF search string [$cql_query] converted to "
. "[$qualifier:$term]\n");
my $page_size = $req->maximumRecords;
$page_size ||= 10;
# startwith deals with pages, so convert startRecord to a page number
my $page = ($req->startRecord / $page_size) || 0;
my $recs;
if ($qualifier eq "id") {
$recs = [ int($term) ];
} else {
my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
my $method = "open-ils.supercat.authority.browse_top.by_axis";
$method .= ".refs" if $refs;
$recs = $supercat->request(
$method,
$realaxis,
$term,
$page,
$page_size
)->gather(1);
}
my $record_position = $req->startRecord;
my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
foreach my $record (@$recs) {
my $marcxml = $cstore->request(
'open-ils.cstore.direct.authority.record_entry.retrieve', $record
)->gather(1)->marc;
$resp->addRecord(
SRU::Response::Record->new(
recordSchema => 'info:srw/schema/1/marcxml-v1.1',
recordData => $marcxml,
recordPosition => ++$record_position
)
);
}
$resp->numberOfRecords(scalar(@$recs));
}
=head2 get_ou($org_unit)
Returns an aou object for a given actor.org_unit shortname or ID.
=cut
sub get_ou {
my $org = shift || '-';
my $org_unit;
if ($org eq '-') {
$org_unit = $actor->request(
'open-ils.actor.org_unit_list.search' => parent_ou => undef
)->gather(1);
} elsif ($org !~ /^\d+$/o) {
$org_unit = $actor->request(
'open-ils.actor.org_unit_list.search' => shortname => uc($org)
)->gather(1);
} else {
$org_unit = $actor->request(
'open-ils.actor.org_unit_list.search' => id => $org
)->gather(1);
}
return $org_unit;
}
1;
# vim: et:ts=4:sw=4