1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
5 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
6 use APR::Const -compile => qw(:error SUCCESS);
7 use Apache2::RequestRec ();
8 use Apache2::RequestIO ();
9 use Apache2::RequestUtil;
15 use OpenSRF::EX qw(:try);
16 use OpenILS::Utils::DateTime qw/:datetime/;
17 use OpenSRF::Utils::Cache;
19 use OpenSRF::AppSession;
24 use Unicode::Normalize;
25 use OpenILS::Utils::Fieldmapper;
26 use OpenILS::WWW::SuperCat::Feed;
27 use OpenILS::WWW::SuperCat::OAI;
28 use OpenSRF::Utils::Logger qw/$logger/;
29 use OpenILS::Application::AppUtils;
30 use OpenILS::Utils::TagURI;
33 use MARC::File::XML ( BinaryEncoding => 'UTF-8' );
35 my $log = 'OpenSRF::Utils::Logger';
36 my $U = 'OpenILS::Application::AppUtils';
38 # set the bootstrap config when this module is loaded
39 my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
41 my $authority_axis_re = qr/^authority\.(\w+)(\.refs)?$/;
43 my %extra_header_action_per_type = (
45 {"Content-Disposition" =>
46 sub { "attachment;filename=" . time . ".mrc"}}
50 $browse_types{call_number}{xml} = sub {
53 my $year = (gmtime())[5] + 1900;
56 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
59 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
60 $cn_class =~ s/Fieldmapper-//gso;
62 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
63 my $cn_lib = $cn->owning_lib->shortname;
64 my $cn_label = $cn->label;
65 my $cn_prefix = $cn->prefix->label;
66 my $cn_suffix = $cn->suffix->label;
68 $cn_label =~ s/\n//gos;
69 $cn_label =~ s/&/&/go;
70 $cn_label =~ s/'/'/go;
71 $cn_label =~ s/</</go;
72 $cn_label =~ s/>/>/go;
74 $cn_prefix =~ s/\n//gos;
75 $cn_prefix =~ s/&/&/go;
76 $cn_prefix =~ s/'/'/go;
77 $cn_prefix =~ s/</</go;
78 $cn_prefix =~ s/>/>/go;
80 $cn_suffix =~ s/\n//gos;
81 $cn_suffix =~ s/&/&/go;
82 $cn_suffix =~ s/'/'/go;
83 $cn_suffix =~ s/</</go;
84 $cn_suffix =~ s/>/>/go;
86 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
87 $ou_class =~ s/Fieldmapper-//gso;
89 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
90 my $ou_name = $cn->owning_lib->name;
92 $ou_name =~ s/\n//gos;
93 $ou_name =~ s/'/'/go;
95 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
96 $rec_class =~ s/Fieldmapper-//gso;
98 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
100 $content .= "<volume id='$cn_tag' lib='$cn_lib' prefix='$cn_prefix' label='$cn_label' suffix='$cn_suffix'>\n";
101 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
103 my $r_doc = $parser->parse_string($cn->record->marc);
104 $r_doc->documentElement->setAttribute( id => $rec_tag );
105 $content .= $U->entityize($r_doc->documentElement->toString);
107 $content .= "</volume>\n";
110 $content .= "</volumes>\n";
111 return ("Content-type: application/xml\n\n",$content);
115 $browse_types{call_number}{html} = sub {
120 if (!$cn_browse_xslt) {
121 $cn_browse_xslt = $parser->parse_file(
122 OpenSRF::Utils::SettingsClient
124 ->config_value( dirs => 'xsl' ).
127 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
130 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
133 "Content-type: text/html\n\n",
135 $cn_browse_xslt->transform(
136 $parser->parse_string( $xml ),
151 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
153 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
154 Fieldmapper->import(IDL => $idl);
156 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
157 $actor = OpenSRF::AppSession->create('open-ils.actor');
158 $search = OpenSRF::AppSession->create('open-ils.search');
159 $parser = new XML::LibXML;
160 $xslt = new XML::LibXSLT;
162 $cn_browse_xslt = $parser->parse_file(
163 OpenSRF::Utils::SettingsClient
165 ->config_value( dirs => 'xsl' ).
169 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
171 %qualifier_map = %{$supercat
172 ->request("open-ils.supercat.biblio.search_aliases")
175 my %attribute_desc = (
176 site => 'Evergreen Site Code (shortname)',
177 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
178 dir => 'Sort direction (asc|desc)',
179 available => 'Filter to available (true|false)',
182 # Append the non-search-alias attributes to the qualifier map
199 preferred_language_weight
200 preferred_language_multiplier
202 $qualifier_map{'eg'}{$_}{'index'} = $_;
203 if (exists $attribute_desc{$_}) {
204 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
206 $qualifier_map{'eg'}{$_}{'title'} = $_;
211 ->request("open-ils.supercat.record.formats")
214 $list = [ map { (keys %$_)[0] } @$list ];
215 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
217 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
218 for my $record_browse_format ( @$list ) {
220 my $__f = $record_browse_format;
221 my $__a = $browse_axis;
223 $browse_types{$__a}{$__f} = sub {
224 my $record_list = shift;
227 my $real_format = shift || $__f;
232 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
233 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
234 $feed->root( "$base/../" );
236 $feed->link( next => $next => $feed->type );
237 $feed->link( previous => $prev => $feed->type );
240 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
248 my $auth_axes = $supercat
249 ->request("open-ils.supercat.authority.browse_axis_list")
253 for my $axis ( @$auth_axes ) {
254 my $basic_axis = 'authority.' . $axis;
255 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
258 my $__a = $browse_axis;
260 $browse_types{$__a}{$__f} = sub {
261 my $record_list = shift;
264 my $real_format = shift || $__f;
269 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
270 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
271 $feed->root( "$base/../" );
272 $feed->link( next => $next => $feed->type );
273 $feed->link( previous => $prev => $feed->type );
276 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
284 OpenILS::WWW::SuperCat::OAI::child_init();
286 return Apache2::Const::OK;
289 sub check_child_init() {
290 if (!defined $supercat || !defined $actor || !defined $search) {
291 # For some reason one (or more) of our appsessions is missing....
297 =head2 parse_feed_type($type)
299 Determines whether and how a given feed type needs to be "fleshed out"
300 with holdings information.
302 The feed type could end with the string "-full", in which case we want
303 to return call numbers, copies, and URIS.
305 Or the feed type could end with "-uris", in which case we want to return
306 call numbers and URIS.
308 Otherwise, we won't return any holdings.
312 sub parse_feed_type {
313 my $type = shift || '';
315 if ($type =~ /-full$/o) {
319 if ($type =~ /-uris$/o) {
323 # Otherwise, we'll return just the facts, ma'am
327 =head2 supercat_format($format_hashref, $format_type)
329 Given a reference to a hash containing the namespace_uri,
330 docs, and schema location attributes for a set of formats,
331 generate the XML description required by the supercat service.
333 We derive the base type from the format type so that we do not
334 have to populate the hash with redundant information.
338 sub supercat_format {
342 (my $base_type = $type) =~ s/(-full|-uris)$//o;
344 my $format = "<format><name>$type</name><type>application/xml</type>";
346 for my $part ( qw/namespace_uri docs schema_location/ ) {
347 $format .= "<$part>$$h{$base_type}{$part}</$part>"
348 if ($$h{$base_type}{$part});
351 $format .= '</format>';
356 =head2 unapi_format($format_hashref, $format_type)
358 Given a reference to a hash containing the namespace_uri,
359 docs, and schema location attributes for a set of formats,
360 generate the XML description required by the supercat service.
362 We derive the base type from the format type so that we do not
363 have to populate the hash with redundant information.
371 (my $base_type = $type) =~ s/(-full|-uris)$//o;
373 my $format = "<format name='$type' type='application/xml'";
375 for my $part ( qw/namespace_uri docs schema_location/ ) {
376 $format .= " $part='$$h{$base_type}{$part}'"
377 if ($$h{$base_type}{$part});
386 # Return a list of strings suitable for printing on STDOUT as HTTP headers.
387 sub extra_headers_per_type_to_string {
389 if (my $list = $extra_header_action_per_type{$type}) {
391 my $str = (keys(%$_))[0] . ": ";
392 my $value = (values(%$_))[0];
393 if (ref $value eq 'CODE') {
396 return $str . $value . "\n";
402 # Return key/value pairs suitable for feeding into CGI::header()
403 sub extra_headers_per_type_to_cgi {
406 if (my $list = $extra_header_action_per_type{$type}) {
408 my $key = (keys(%$_))[0];
409 my $value = (values(%$_))[0];
410 if (ref $value eq 'CODE') {
413 return $key => $value;
422 return Apache2::Const::DECLINED if (-e $apache->filename);
426 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
429 ->request("open-ils.supercat.oisbn", $isbn)
432 print "Content-type: application/xml; charset=utf-8\n\n";
433 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
435 unless (exists $$list{metarecord}) {
437 return Apache2::Const::OK;
440 print "<idlist metarecord='$$list{metarecord}'>\n";
442 for ( keys %{ $$list{record_list} } ) {
443 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
444 print " <isbn record='$_'>$o</isbn>\n"
449 return Apache2::Const::OK;
457 my $ctype = 'application/xml';
458 # Only bre and biblio_record_entry_feed have tranforms, but we'll ignore that for now
459 if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/ and $format ne 'xml') {
460 # XXX set $ctype to something else
463 print "Content-type: $ctype; charset=utf-8\n\n";
464 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
466 $supercat->request("open-ils.supercat.u2", $u2->toURI, $format)
470 return Apache2::Const::OK;
477 print "Content-type: application/xml; charset=utf-8\n\n";
478 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
480 if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/) {
481 # TODO: if/when unapi.bre_output_layout becomes something
482 # that actually changes, the hard-coding here should be
486 <format name="holdings_xml" type="application/xml"/>
487 <format name="marcxml" type="application/xml" namespace_uri="http://www.loc.gov/MARC21/slim" docs="http://www.loc.gov/marcxml/" schema_location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"/>
488 <format name="mods32" type="application/xml" namespace_uri="http://www.loc.gov/mods/v3" docs="http://www.loc.gov/mods/" schema_location="http://www.loc.gov/standards/mods/v3/mods-3-2.xsd"/>
494 <format name="xml" type="application/xml"/>
499 return Apache2::Const::OK;
505 return Apache2::Const::DECLINED if (-e $apache->filename);
512 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
513 my $rel_name = $cgi->url(-relative=>1);
514 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
517 my $url = $cgi->url(-path_info=>$add_path);
518 my $root = (split 'unapi', $url)[0];
519 my $base = (split 'unapi', $url)[0] . 'unapi';
522 my $uri = $cgi->param('id') || '';
524 my $format = $cgi->param('format') || '';
525 (my $base_format = $format) =~ s/(-full|-uris)$//o;
526 my $u2uri = OpenILS::Utils::TagURI->new($uri);
527 if ($u2uri->version > 1) {
529 return unapi2($apache, $u2uri, $format);
531 return unapi2_formats($apache, $u2uri);
535 my $host = $cgi->virtual_host || $cgi->server_name;
537 my $skin = $cgi->param('skin') || 'default';
538 my $locale = $cgi->param('locale') || 'en-US';
540 # Enable localized results of copy status, etc
541 $supercat->session_locale($locale);
543 my $flesh_feed = parse_feed_type($format);
544 ($base_format = $format) =~ s/(-full|-uris)$//o;
545 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
546 my $body = "Content-type: application/xml; charset=utf-8\n\n";
548 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
551 ($lib,$depth) = split('/', $4);
552 $type = 'metarecord' if ($1 =~ /^m/o);
553 $type = 'authority' if ($1 =~ /^authority/o);
557 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
560 ->request("open-ils.supercat.$type.formats")
563 if ($type eq 'record' or $type eq 'isbn') {
564 $body .= <<" FORMATS";
566 <format name='opac' type='text/html'/>
567 <format name='html' type='text/html'/>
568 <format name='htmlholdings' type='text/html'/>
569 <format name='holdings_xml' type='application/xml'/>
570 <format name='holdings_xml-full' type='application/xml'/>
571 <format name='html-full' type='text/html'/>
572 <format name='htmlholdings-full' type='text/html'/>
573 <format name='marctxt' type='text/plain'/>
574 <format name='ris' type='text/plain'/>
576 } elsif ($type eq 'metarecord') {
577 $body .= <<" FORMATS";
579 <format name='opac' type='text/html'/>
582 $body .= <<" FORMATS";
588 my ($type) = keys %$h;
589 $body .= unapi_format($h, $type);
591 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
592 $body .= unapi_format($h, "$type-full");
593 $body .= unapi_format($h, "$type-uris");
597 $body .= "</formats>\n";
601 ->request("open-ils.supercat.$type.formats")
606 ->request("open-ils.supercat.metarecord.formats")
610 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
611 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
613 $body .= <<" FORMATS";
615 <format name='opac' type='text/html'/>
616 <format name='html' type='text/html'/>
617 <format name='htmlholdings' type='text/html'/>
618 <format name='holdings_xml' type='application/xml'/>
619 <format name='holdings_xml-full' type='application/xml'/>
620 <format name='html-full' type='text/html'/>
621 <format name='htmlholdings-full' type='text/html'/>
622 <format name='marctxt' type='text/plain'/>
623 <format name='ris' type='text/plain'/>
628 my ($type) = keys %$h;
629 $body .= "\t" . unapi_format($h, $type);
631 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
632 $body .= "\t" . unapi_format($h, "$type-full");
633 $body .= "\t" . unapi_format($h, "$type-uris");
637 $body .= "</formats>\n";
641 return Apache2::Const::OK;
645 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
649 ($lib,$depth) = split('/', $4);
651 $type = 'metarecord' if ($scheme =~ /^metabib/o);
652 $type = 'isbn' if ($scheme =~ /^isbn/o);
653 $type = 'acp' if ($scheme =~ /^asset-copy/o);
654 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
655 $type = 'auri' if ($scheme =~ /^asset-uri/o);
656 $type = 'authority' if ($scheme =~ /^authority/o);
657 $command = 'retrieve';
658 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
659 $command = 'browse' if ($scheme =~ /^authority/);
663 $paging = [split ',', $paging];
668 if (!$lib || $lib eq '-') {
669 $lib = $actor->request(
670 'open-ils.actor.org_unit_list.search' => parent_ou => undef
671 )->gather(1)->[0]->shortname;
674 my ($lib_object,$lib_id,$ou_types,$lib_depth);
675 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
676 $lib_object = $actor->request(
677 'open-ils.actor.org_unit_list.search' => shortname => $lib
679 $lib_id = $lib_object->id;
681 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
682 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
685 if ($command eq 'browse') {
686 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
690 if ($type eq 'isbn') {
691 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
693 # Escape user input before display
694 $command = CGI::escapeHTML($command);
695 $id = CGI::escapeHTML($id);
696 $type = CGI::escapeHTML($type);
697 $format = CGI::escapeHTML(decode_utf8($format));
699 print "Content-type: text/html; charset=utf-8\n\n";
700 $apache->custom_response( 404, <<" HTML");
703 <title>Type [$type] with id [$id] not found!</title>
707 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
718 { (keys(%$_))[0] eq $base_format }
719 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
721 { $_ eq $base_format }
722 qw/opac html htmlholdings marctxt ris holdings_xml/
724 # Escape user input before display
725 $format = CGI::escapeHTML($format);
726 $type = CGI::escapeHTML($type);
728 print "Content-type: text/html; charset=utf-8\n\n";
729 $apache->custom_response( 406, <<" HTML");
732 <title>Invalid format [$format] for type [$type]!</title>
736 <center>Sorry, format $format is not valid for type $type.</center>
743 if ($format eq 'opac') {
744 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
745 if ($type eq 'metarecord');
746 print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
747 if ($type eq 'record');
749 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
750 my $feed = create_record_feed(
761 # Escape user input before display
762 $command = CGI::escapeHTML($command);
763 $id = CGI::escapeHTML($id);
764 $type = CGI::escapeHTML($type);
765 $format = CGI::escapeHTML(decode_utf8($format));
767 print "Content-type: text/html; charset=utf-8\n\n";
768 $apache->custom_response( 404, <<" HTML");
771 <title>Type [$type] with id [$id] not found!</title>
775 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
783 $feed->creator($host);
785 $feed->link( unapi => $base) if ($flesh_feed);
787 print "Content-type: ". $feed->type ."; charset=utf-8\n";
789 print $_ for extra_headers_per_type_to_string($type);
791 print "\n", $feed->toString, "\n";
793 return Apache2::Const::OK;
796 my $method = "open-ils.supercat.$type.$base_format.$command";
798 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
800 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
801 # however, we can have it carry extra options like no_record! (comma separated)
802 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
804 my $req = $supercat->request($method,@params);
805 my $data = $req->gather();
807 if ($req->failed || !$data) {
808 # Escape user input before display
809 $command = CGI::escapeHTML($command);
810 $id = CGI::escapeHTML($id);
811 $type = CGI::escapeHTML($type);
812 $format = CGI::escapeHTML(decode_utf8($format));
814 print "Content-type: text/html; charset=utf-8\n\n";
815 $apache->custom_response( 404, <<" HTML");
818 <title>$type $id not found!</title>
822 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
829 print "Content-type: application/xml; charset=utf-8\n\n";
831 # holdings_xml format comes back to us without an XML declaration
832 # and without being entityized; fix that here
833 if ($base_format eq 'holdings_xml') {
834 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
835 print $U->entityize($data);
837 while (my $c = $req->recv) {
838 print $U->entityize($c->content);
844 return Apache2::Const::OK;
850 return Apache2::Const::DECLINED if (-e $apache->filename);
857 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
858 my $rel_name = $cgi->url(-relative=>1);
859 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
862 my $url = $cgi->url(-path_info=>$add_path);
863 my $root = (split 'supercat', $url)[0];
864 my $base = (split 'supercat', $url)[0] . 'supercat';
865 my $unapi = (split 'supercat', $url)[0] . 'unapi';
867 my $host = $cgi->virtual_host || $cgi->server_name;
869 my $path = $cgi->path_info;
870 my ($id,$type,$format,$command) = reverse split '/', $path;
871 my $flesh_feed = parse_feed_type($format);
872 (my $base_format = $format) =~ s/(-full|-uris)$//o;
874 my $skin = $cgi->param('skin') || 'default';
875 my $locale = $cgi->param('locale') || 'en-US';
877 # Enable localized results of copy status, etc
878 $supercat->session_locale($locale);
880 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
881 print "Content-type: application/xml; charset=utf-8\n";
884 ->request("open-ils.supercat.$1.formats")
892 <type>text/html</type>
895 if ($1 eq 'record' or $1 eq 'isbn') {
897 <name>htmlholdings</name>
898 <type>text/html</type>
902 <type>text/html</type>
905 <name>htmlholdings-full</name>
906 <type>text/html</type>
909 <name>html-full</name>
910 <type>text/html</type>
914 <type>text/plain</type>
918 <type>text/plain</type>
923 my ($type) = keys %$h;
924 print supercat_format($h, $type);
926 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
927 print supercat_format($h, "$type-full");
928 print supercat_format($h, "$type-uris");
933 print "</formats>\n";
935 return Apache2::Const::OK;
939 ->request("open-ils.supercat.record.formats")
944 ->request("open-ils.supercat.metarecord.formats")
948 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
949 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
954 <type>text/html</type>
957 <name>htmlholdings</name>
958 <type>text/html</type>
962 <type>text/html</type>
965 <name>htmlholdings-full</name>
966 <type>text/html</type>
969 <name>html-full</name>
970 <type>text/html</type>
974 <type>text/plain</type>
978 <type>text/plain</type>
982 my ($type) = keys %$h;
983 print supercat_format($h, $type);
985 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
986 print supercat_format($h, "$type-full");
987 print supercat_format($h, "$type-uris");
992 print "</formats>\n";
995 return Apache2::Const::OK;
998 if ($format eq 'opac') {
999 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
1000 if ($type eq 'metarecord');
1001 print "Location: /eg/opac/record/$id\n\n"
1002 if ($type eq 'record');
1005 } elsif ($base_format eq 'marc21') {
1009 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
1011 print "Content-type: application/octet-stream\n";
1012 print $_ for extra_headers_per_type_to_string($base_format);
1013 print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
1018 # Escape user input before display
1019 $id = CGI::escapeHTML($id);
1021 print "Content-type: text/html; charset=utf-8\n\n";
1022 $apache->custom_response( 404, <<" HTML");
1025 <title>ERROR</title>
1029 <center>Couldn't fetch $id as MARC21.</center>
1036 return Apache2::Const::OK;
1038 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
1039 my $feed = create_record_feed(
1042 undef, undef, undef,
1047 $feed->creator($host);
1051 $feed->link( unapi => $base) if ($flesh_feed);
1053 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1055 print $_ for extra_headers_per_type_to_string($type);
1057 print "\n", $feed->toString, "\n";
1059 return Apache2::Const::OK;
1062 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
1063 $req->wait_complete;
1066 # Escape user input before display
1067 $command = CGI::escapeHTML($command);
1068 $id = CGI::escapeHTML($id);
1069 $type = CGI::escapeHTML($type);
1070 $format = CGI::escapeHTML(decode_utf8($format));
1072 print "Content-type: text/html; charset=utf-8\n\n";
1073 $apache->custom_response( 404, <<" HTML");
1076 <title>$type $id not found!</title>
1080 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
1087 print "Content-type: application/xml; charset=utf-8\n\n";
1088 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
1090 return Apache2::Const::OK;
1096 return Apache2::Const::DECLINED if (-e $apache->filename);
1102 my $year = (gmtime())[5] + 1900;
1103 my $host = $cgi->virtual_host || $cgi->server_name;
1106 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1107 my $rel_name = $cgi->url(-relative=>1);
1108 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1111 my $url = $cgi->url(-path_info=>$add_path);
1112 my $root = (split 'feed', $url)[0] . '/';
1113 my $base = (split 'bookbag', $url)[0] . '/bookbag';
1114 my $unapi = (split 'feed', $url)[0] . '/unapi';
1116 my $skin = $cgi->param('skin') || 'default';
1117 my $locale = $cgi->param('locale') || 'en-US';
1118 my $org = $cgi->param('searchOrg');
1120 # Enable localized results of copy status, etc
1121 $supercat->session_locale($locale);
1123 my $org_unit = get_ou($org);
1124 my $scope = "l=" . $org_unit->[0]->id . "&";
1126 $root =~ s{(?<!http:)//}{//}go;
1127 $base =~ s{(?<!http:)//}{//}go;
1128 $unapi =~ s{(?<!http:)//}{//}go;
1130 my $path = $cgi->path_info;
1131 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1133 my ($id,$type) = reverse split '/', $path;
1134 my $flesh_feed = parse_feed_type($type);
1136 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1137 return Apache2::Const::NOT_FOUND unless($bucket);
1139 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1140 if (lc($type) eq 'opac') {
1141 print "Location: /eg/opac/results?bookbag=$id\n\n";
1145 # last created first
1146 my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1148 my $feed = create_record_feed(
1151 [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1153 $org_unit->[0]->shortname,
1158 $feed->id($bucket_tag);
1160 $feed->title($bucket->name);
1161 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1162 $feed->creator($host);
1165 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1166 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1167 $feed->link(opac => $base . "/opac/$id" => 'text/html');
1168 $feed->link(OPAC => $base . "/opac/$id" => 'text/html');
1169 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1170 $feed->link(unapi => $unapi);
1172 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1173 print $feed->toString . "\n";
1175 return Apache2::Const::OK;
1180 return Apache2::Const::DECLINED if (-e $apache->filename);
1186 my $year = (gmtime())[5] + 1900;
1187 my $host = $cgi->virtual_host || $cgi->server_name;
1190 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1191 my $rel_name = $cgi->url(-relative=>1);
1192 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1195 my $url = $cgi->url(-path_info=>$add_path);
1196 my $root = (split 'feed', $url)[0];
1197 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1198 my $unapi = (split 'feed', $url)[0] . 'unapi';
1200 my $skin = $cgi->param('skin') || 'default';
1201 my $locale = $cgi->param('locale') || 'en-US';
1202 my $org = $cgi->param('searchOrg');
1204 # Enable localized results of copy status, etc
1205 $supercat->session_locale($locale);
1207 my $org_unit = get_ou($org);
1208 my $scope = "l=" . $org_unit->[0]->id . "&";
1210 my $path = $cgi->path_info;
1211 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1213 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1215 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1216 my $flesh_feed = parse_feed_type($type);
1219 $limit = 10 if $limit !~ /^\d+$/;
1221 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1223 if (lc($type) eq 'opac') {
1224 print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
1228 my $search = 'record';
1229 if ($rtype eq 'authority') {
1230 $search = 'authority';
1232 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1236 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1238 $feed->title("$limit most recent $rtype ${axis}s");
1241 $feed->creator($host);
1244 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1245 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1246 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1247 $feed->link(unapi => $unapi);
1251 "http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
1256 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1258 print $_ for extra_headers_per_type_to_string($type);
1260 print "\n", $feed->toString, "\n";
1262 return Apache2::Const::OK;
1265 sub opensearch_osd {
1266 my $version = shift;
1272 if ($version eq '1.0') {
1274 Content-type: application/opensearchdescription+xml; charset=utf-8
1276 <?xml version="1.0" encoding="UTF-8"?>
1277 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1278 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1279 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1280 <ShortName>$lib</ShortName>
1281 <LongName>Search $lib</LongName>
1282 <Description>Search the $lib OPAC by $class.</Description>
1283 <Tags>$lib book library</Tags>
1284 <SampleSearch>harry+potter</SampleSearch>
1285 <Developer>Mike Rylander for GPLS/PINES</Developer>
1286 <Contact>feedback\@open-ils.org</Contact>
1287 <SyndicationRight>open</SyndicationRight>
1288 <AdultContent>false</AdultContent>
1289 </OpenSearchDescription>
1293 Content-type: application/opensearchdescription+xml; charset=utf-8
1295 <?xml version="1.0" encoding="UTF-8"?>
1296 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1297 <ShortName>$lib</ShortName>
1298 <Description>Search the $lib OPAC by $class.</Description>
1299 <Tags>$lib book library</Tags>
1300 <Url type="application/rss+xml"
1301 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1302 <Url type="application/atom+xml"
1303 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1304 <Url type="application/x-mods3+xml"
1305 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1306 <Url type="application/x-mods+xml"
1307 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1308 <Url type="application/octet-stream"
1309 template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1310 <Url type="application/x-marcxml+xml"
1311 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1312 <Url type="text/html"
1313 template="https://$host/eg/opac/results?locg=$lib;query={searchTerms};page={startPage?};startIndex={startIndex?};count={count?};searchLang={language?}"/>
1314 <LongName>Search $lib</LongName>
1315 <Query role="example" searchTerms="harry+potter" />
1316 <Developer>Mike Rylander for GPLS/PINES</Developer>
1317 <Contact>feedback\@open-ils.org</Contact>
1318 <SyndicationRight>open</SyndicationRight>
1319 <AdultContent>false</AdultContent>
1320 <Language>en-US</Language>
1321 <OutputEncoding>UTF-8</OutputEncoding>
1322 <InputEncoding>UTF-8</InputEncoding>
1323 </OpenSearchDescription>
1327 return Apache2::Const::OK;
1330 sub opensearch_feed {
1332 return Apache2::Const::DECLINED if (-e $apache->filename);
1337 my $year = (gmtime())[5] + 1900;
1339 my $host = $cgi->virtual_host || $cgi->server_name;
1342 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1343 my $rel_name = $cgi->url(-relative=>1);
1344 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1347 my $url = $cgi->url(-path_info=>$add_path);
1348 my $root = (split 'opensearch', $url)[0];
1349 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1350 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1352 my $path = $cgi->path_info;
1353 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1355 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1361 if (!$lib || $lib eq '-') {
1362 $lib = $actor->request(
1363 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1364 )->gather(1)->[0]->shortname;
1367 if ($class eq '-') {
1371 return opensearch_osd($version, $lib, $class, $base, $host);
1375 my $page = $cgi->param('startPage') || 1;
1376 my $offset = $cgi->param('startIndex') || 1;
1377 my $limit = $cgi->param('count') || 10;
1379 $page = 1 if ($page !~ /^\d+$/);
1380 $offset = 1 if ($offset !~ /^\d+$/);
1381 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1384 $offset = ($page - 1) * $limit;
1389 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1390 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1392 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1393 $lang = '' if ($lang eq '*');
1395 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1397 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1400 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1401 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1403 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1406 $type = $cgi->param('responseType') if $cgi->param('responseType');
1409 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1413 my $kwt = $cgi->param('kw');
1414 my $tit = $cgi->param('ti');
1415 my $aut = $cgi->param('au');
1416 my $sut = $cgi->param('su');
1417 my $set = $cgi->param('se');
1419 $terms .= " " if ($terms && $kwt);
1420 $terms .= "keyword: $kwt" if ($kwt);
1421 $terms .= " " if ($terms && $tit);
1422 $terms .= "title: $tit" if ($tit);
1423 $terms .= " " if ($terms && $aut);
1424 $terms .= "author: $aut" if ($aut);
1425 $terms .= " " if ($terms && $sut);
1426 $terms .= "subject: $sut" if ($sut);
1427 $terms .= " " if ($terms && $set);
1428 $terms .= "series: $set" if ($set);
1430 if ($version eq '1.0') {
1432 } elsif ($type eq '-') {
1435 my $flesh_feed = parse_feed_type($type);
1437 $terms = decode_utf8($terms);
1438 $lang = 'eng' if ($lang eq 'en-US');
1440 $log->debug("OpenSearch terms: $terms");
1442 my $org_unit = get_ou($org);
1444 my $safe_terms = $terms;
1446 # XXX Apostrophes used to break search, but no longer do. The following
1447 # XXX line breaks phrase searching in OpenSearch, and should be removed.
1448 $safe_terms =~ s{'}{ }go;
1450 my $query_terms = 'site('.$org_unit->[0]->shortname.") $safe_terms";
1451 $query_terms = "sort($sort) $query_terms" if ($sort);
1452 $query_terms = "language($lang) $query_terms" if ($lang);
1453 $query_terms = "#$sortdir $query_terms" if ($sortdir);
1455 my $recs = $search->request(
1456 'open-ils.search.biblio.multiclass.query' => {
1459 } => $query_terms => 1
1462 $log->debug("Hits for [$terms]: $recs->{count}");
1464 my $feed = create_record_feed(
1467 [ map { $_->[0] } @{$recs->{ids}} ],
1474 $log->debug("Feed created...");
1478 $feed->search($safe_terms);
1479 $feed->class($class);
1481 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1483 $feed->creator($host);
1486 $feed->_create_node(
1487 $feed->{item_xpath},
1488 'http://a9.com/-/spec/opensearch/1.1/',
1493 $feed->_create_node(
1494 $feed->{item_xpath},
1495 'http://a9.com/-/spec/opensearch/1.1/',
1500 $feed->_create_node(
1501 $feed->{item_xpath},
1502 'http://a9.com/-/spec/opensearch/1.1/',
1507 $log->debug("...basic feed data added...");
1511 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1512 'application/opensearch+xml'
1513 ) if ($offset + $limit < $recs->{count});
1517 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1518 'application/opensearch+xml'
1523 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1524 'application/opensearch+xml'
1529 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1530 'application/rss+xml'
1535 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1536 'application/atom+xml'
1541 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1547 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1551 $feed->link( 'unapi-server' => $unapi);
1553 $log->debug("...feed links added...");
1557 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1558 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1562 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1564 -type => $feed->type, -charset => 'UTF-8',
1565 extra_headers_per_type_to_cgi($type)
1566 ), $feed->toString, "\n";
1568 $log->debug("...and feed returned.");
1570 return Apache2::Const::OK;
1573 sub create_record_feed {
1576 my $records = shift;
1579 my $lib = uc(shift()) || '-';
1586 my $base = $cgi->url;
1587 my $host = $cgi->virtual_host || $cgi->server_name;
1589 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1593 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1595 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1597 $type =~ s/(-full|-uris)$//o;
1599 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1600 $feed->base($base) if ($flesh);
1601 $feed->unapi($unapi) if ($flesh);
1603 $type = 'atom' if ($type eq 'html');
1604 $type = 'marcxml' if
1605 $type eq 'htmlholdings' or
1606 $type eq 'marctxt' or
1608 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1610 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1613 for my $record (@$records) {
1614 next unless($record);
1616 #my $rec = $record->id;
1619 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1620 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1621 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1622 $item_tag .= "/$depth" if (defined($depth));
1624 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1626 my $xml = $supercat->request(
1627 "open-ils.supercat.$search.$type.retrieve",
1632 my $node = $feed->add_item($xml);
1636 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1637 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1638 while ( !$r->complete ) {
1639 $xml .= join('', map {$_->content} $r->recv);
1641 $xml .= join('', map {$_->content} $r->recv);
1642 $node->add_holdings($xml);
1645 $node->id($item_tag);
1646 #$node->update_ts(clean_ISO8601($record->edit_date));
1647 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1648 $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1649 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1650 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1651 $node->link('unapi-id' => $item_tag) if ($flesh);
1659 return Apache2::Const::DECLINED if (-e $apache->filename);
1664 my $year = (gmtime())[5] + 1900;
1666 my $host = $cgi->virtual_host || $cgi->server_name;
1669 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1670 my $rel_name = $cgi->url(-relative=>1);
1671 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1674 my $url = $cgi->url(-path_info=>$add_path);
1675 my $root = (split 'browse', $url)[0];
1676 my $base = (split 'browse', $url)[0] . 'browse';
1677 my $unapi = (split 'browse', $url)[0] . 'unapi';
1679 my $path = $cgi->path_info;
1682 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1683 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1685 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1687 my $status = [$cgi->param('status')];
1688 my $cpLoc = [$cgi->param('copyLocation')];
1689 $site ||= $cgi->param('searchOrg');
1690 $page ||= $cgi->param('startPage') || 0;
1691 $page_size ||= $cgi->param('count') || 9;
1692 $thesauruses //= '';
1693 $thesauruses =~ s/\s//g;
1694 # protect against cats bouncing on the comma key...
1695 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1697 $page = 0 if ($page !~ /^-?\d+$/);
1698 $page_size = 9 if $page_size !~ /^\d+$/;
1700 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1701 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1703 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1704 warn "something's wrong...";
1705 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1709 $string = decode_utf8($string);
1710 $string =~ s/\+/ /go;
1714 if ($axis =~ /^authority/) {
1715 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1717 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1718 $method .= ".refs" if $refs;
1720 $tree = $supercat->request(
1729 $tree = $supercat->request(
1730 "open-ils.supercat.$axis.browse",
1740 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1742 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1743 print $header.$content;
1744 return Apache2::Const::OK;
1747 sub string_startwith {
1749 return Apache2::Const::DECLINED if (-e $apache->filename);
1754 my $year = (gmtime())[5] + 1900;
1756 my $host = $cgi->virtual_host || $cgi->server_name;
1759 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1760 my $rel_name = $cgi->url(-relative=>1);
1761 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1764 my $url = $cgi->url(-path_info=>$add_path);
1765 my $root = (split 'startwith', $url)[0];
1766 my $base = (split 'startwith', $url)[0] . 'startwith';
1767 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1769 my $path = $cgi->path_info;
1772 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1773 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1775 my $status = [$cgi->param('status')];
1776 my $cpLoc = [$cgi->param('copyLocation')];
1777 $site ||= $cgi->param('searchOrg');
1778 $page ||= $cgi->param('startPage') || 0;
1779 $page_size ||= $cgi->param('count') || 9;
1780 $thesauruses //= '';
1781 $thesauruses =~ s/\s//g;
1782 # protect against cats bouncing on the comma key...
1783 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1785 $page = 0 if ($page !~ /^-?\d+$/);
1786 $page_size = 9 if $page_size !~ /^\d+$/;
1788 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1789 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1791 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1792 warn "something's wrong...";
1793 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1797 $string = decode_utf8($string);
1798 $string =~ s/\+/ /go;
1802 if ($axis =~ /^authority/) {
1803 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1805 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1806 $method .= ".refs" if $refs;
1808 $tree = $supercat->request(
1817 $tree = $supercat->request(
1818 "open-ils.supercat.$axis.startwith",
1828 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1830 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1831 print $header.$content;
1832 return Apache2::Const::OK;
1835 sub item_age_browse {
1837 return Apache2::Const::DECLINED if (-e $apache->filename);
1842 my $year = (gmtime())[5] + 1900;
1844 my $host = $cgi->virtual_host || $cgi->server_name;
1847 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1848 my $rel_name = $cgi->url(-relative=>1);
1849 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1852 my $url = $cgi->url(-path_info=>$add_path);
1853 my $root = (split 'browse', $url)[0];
1854 my $base = (split 'browse', $url)[0] . 'browse';
1855 my $unapi = (split 'browse', $url)[0] . 'unapi';
1857 my $path = $cgi->path_info;
1860 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1861 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1863 unless ($axis eq 'item-age') {
1864 warn "something's wrong...";
1865 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1869 my $status = [$cgi->param('status')];
1870 my $cpLoc = [$cgi->param('copyLocation')];
1871 $site ||= $cgi->param('searchOrg') || '-';
1872 $page ||= $cgi->param('startPage') || 1;
1873 $page_size ||= $cgi->param('count') || 10;
1875 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1876 $page_size = 10 if $page_size !~ /^\d+$/;
1878 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1879 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1881 my $recs = $supercat->request(
1882 "open-ils.supercat.new_book_list",
1890 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1892 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1893 print $header.$content;
1894 return Apache2::Const::OK;
1897 our %qualifier_ids = (
1898 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1899 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1900 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1904 # Our authority search options are currently pretty impoverished;
1905 # just right-truncated string match on a few categories, or by
1907 our %nested_auth_qualifier_map = (
1909 id => { index => 'id', title => 'Record number'},
1910 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1911 title => { index => 'title', title => 'Uniform title'},
1912 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1913 topic => { index => 'topic', title => 'Topical term'},
1917 my $base_explain = <<XML;
1919 id="evergreen-sru-explain-full"
1920 authoritative="true"
1921 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1922 xmlns="http://explain.z3950.org/dtd/2.0/">
1923 <serverInfo transport="http" protocol="SRU" version="1.1">
1930 <title primary="true"/>
1931 <description primary="true"/>
1935 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1940 identifier="info:srw/schema/1/marcxml-v1.1"
1941 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1945 <title>MARC21Slim (marcxml)</title>
1950 <default type="numberOfRecords">10</default>
1951 <default type="contextSet">eg</default>
1952 <default type="index">keyword</default>
1953 <default type="relation">all</default>
1954 <default type="sortSchema">marcxml</default>
1955 <default type="retrieveSchema">marcxml</default>
1956 <setting type="maximumRecords">50</setting>
1957 <supports type="relationModifier">relevant</supports>
1958 <supports type="relationModifier">stem</supports>
1959 <supports type="relationModifier">fuzzy</supports>
1960 <supports type="relationModifier">word</supports>
1973 my $req = SRU::Request->newFromCGI( $cgi );
1974 my $resp = SRU::Response->newFromRequest( $req );
1976 # Find the org_unit shortname, if passed as part of the URL
1977 # http://example.com/opac/extras/sru/SHORTNAME
1978 my $url = $cgi->path_info;
1979 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1981 if ( $resp->type eq 'searchRetrieve' ) {
1983 # Older versions of Debian packages returned terms to us double-encoded,
1984 # so we had to forcefully double-decode them a second time with
1985 # an outer decode('utf8', $string) call; this seems to be resolved with
1986 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1987 my $cql_query = decode_utf8($req->query);
1988 my $search_string = decode_utf8($req->cql->toEvergreen);
1990 # Ensure the search string overrides the default site
1991 if ($shortname and $search_string !~ m#site:#) {
1992 $search_string = "($search_string) site:$shortname";
1995 my $offset = $req->startRecord;
1996 $offset-- if ($offset);
1999 my $limit = $req->maximumRecords;
2002 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
2004 if (!$shortname || $shortname eq '-') {
2005 my $search_org = get_ou($shortname);
2006 $shortname = $search_org->[0]->shortname;
2009 my $recs = $search->request(
2010 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
2013 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2014 foreach my $rec (@{$recs->{ids}}) {
2015 my $rec_id = shift @$rec;
2016 my $data = $cstore->request(
2017 'open-ils.cstore.json_query' => {
2019 'unapi.bre', $rec_id,
2020 'marcxml', 'record',
2021 ($holdings) ? '{holdings_xml,acp}' : '{}',
2027 my $marcxml = XML::LibXML->load_xml( string => $data->{'unapi.bre'} );
2029 # process <holdings> element, if any
2031 for my $node ($marcxml->getElementsByTagName('holdings')) {
2032 for my $volume ($node->getElementsByTagName('volume')) {
2033 my $prefix = $volume->getChildrenByTagName('call_number_prefix')->[0]->getAttribute('label');
2034 my $suffix = $volume->getChildrenByTagName('call_number_suffix')->[0]->getAttribute('label');
2035 my $cn = $volume->getAttribute('label');
2036 my $owning_lib = $volume->getAttribute('lib');
2037 for my $copy ($volume->getElementsByTagName('copy')) {
2038 # skip copies that aren't OPAC-visible
2040 $copy->getAttribute('opac_visible') eq 'false' ||
2041 $copy->getChildrenByTagName('status')->[0]->getAttribute('opac_visible') eq 'false' ||
2042 $copy->getChildrenByTagName('location')->[0]->getAttribute('opac_visible') eq 'false' ||
2043 $copy->getChildrenByTagName('circ_lib')->[0]->getAttribute('opac_visible') eq 'false'
2046 a => $copy->getChildrenByTagName('location')->[0]->textContent,
2049 d => $copy->getChildrenByTagName('circ_lib')->[0]->getAttribute('shortname'),
2050 g => $copy->getAttribute('barcode'),
2053 n => $copy->getChildrenByTagName('status')->[0]->textContent
2057 # remove <holdings> element
2058 $node->parentNode->removeChild($node);
2061 my $marc = MARC::Record->new_from_xml($marcxml->toString(), 'UTF8', 'XML');
2063 # Force record leader to 'a' as our data is always UTF8
2064 # Avoids marc8_to_utf8 from being invoked with horrible results
2065 # on the off-chance the record leader isn't correct
2066 my $ldr = $marc->leader;
2067 substr($ldr, 9, 1, 'a');
2068 $marc->leader($ldr);
2070 # Expects the record ID in the 001
2071 $marc->delete_field($_) for ($marc->field('001'));
2072 if (!$marc->field('001')) {
2073 $marc->insert_fields_ordered(
2074 MARC::Field->new( '001', $rec_id )
2078 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
2079 for my $copy (@copies) {
2080 $marc->insert_fields_ordered(
2088 ($copy->{k} ? (k => $copy->{k}) : ()),
2089 ($copy->{m} ? (m => $copy->{m}) : ()),
2095 my $output = $marc->as_xml_record();
2096 $output =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2098 SRU::Response::Record->new(
2099 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2100 recordData => $output,
2101 recordPosition => ++$offset
2105 } catch Error with {
2106 $log->error("Failed to process record for SRU search");
2110 $resp->numberOfRecords($recs->{count});
2112 } elsif ( $resp->type eq 'explain' ) {
2113 return_sru_explain($cgi, $req, $resp, \$ex_doc,
2115 \%OpenILS::WWW::SuperCat::qualifier_ids
2119 SRU::Response::Record->new(
2120 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2121 recordData => $ex_doc
2126 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2127 print $U->entityize($resp->asXML) . "\n";
2128 return Apache2::Const::OK;
2133 package CQL::BooleanNode;
2137 my $left = $self->left();
2138 my $right = $self->right();
2139 my $leftStr = $left->toEvergreen;
2140 my $rightStr = $right->toEvergreen();
2142 my $op = '||' if uc $self->op() eq 'OR';
2145 return "$leftStr $op $rightStr";
2148 sub toEvergreenAuth {
2149 return toEvergreen(shift);
2152 package CQL::TermNode;
2156 my $qualifier = $self->getQualifier();
2157 my $term = $self->getTerm();
2158 my $relation = $self->getRelation();
2162 my ($qset, $qname) = split(/\./, $qualifier);
2164 # Per http://www.loc.gov/standards/sru/specs/cql.html
2165 # "All parts of CQL are case insensitive [...] If any case insensitive
2166 # part of CQL is specified with both upper and lower case, it is for
2167 # aesthetic purposes only."
2169 # So fold the qualifier and relation to lower case
2171 $qname = lc($qname);
2173 if ( exists($qualifier_map{$qset}{$qname}) ) {
2174 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2175 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2178 my @modifiers = $relation->getModifiers();
2180 my $base = $relation->getBase();
2181 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2184 foreach my $m ( @modifiers ) {
2185 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2191 $quote_it = 0 if ( $base eq 'all' );
2192 $term = maybeQuote($term) if $quote_it;
2195 croak( "Evergreen doesn't support the $base relations" );
2203 return "$qualifier:$term";
2206 sub toEvergreenAuth {
2208 my $qualifier = $self->getQualifier();
2209 my $term = $self->getTerm();
2210 my $relation = $self->getRelation();
2214 my ($qset, $qname) = split(/\./, $qualifier);
2216 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2217 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2218 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2221 return { qualifier => $qualifier, term => $term };
2226 sub sru_auth_search {
2231 my $req = SRU::Request->newFromCGI( $cgi );
2232 my $resp = SRU::Response->newFromRequest( $req );
2234 if ( $resp->type eq 'searchRetrieve' ) {
2235 return_auth_response($cgi, $req, $resp);
2236 } elsif ( $resp->type eq 'explain' ) {
2237 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2238 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2239 \%OpenILS::WWW::SuperCat::qualifier_ids
2243 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2244 print $U->entityize($resp->asXML) . "\n";
2245 return Apache2::Const::OK;
2248 sub explain_header {
2251 my $host = $cgi->virtual_host || $cgi->server_name;
2254 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2255 my $rel_name = $cgi->url(-relative=>1);
2256 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2258 my $base = $cgi->url(-base=>1);
2259 my $url = $cgi->url(-path_info=>$add_path);
2260 $url =~ s/^$base\///o;
2262 my $doc = $parser->parse_string($base_explain);
2263 my $e = $doc->documentElement;
2264 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2265 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2266 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2271 sub return_sru_explain {
2272 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2274 $index_map ||= \%qualifier_map;
2276 my ($doc, $e) = explain_header($cgi);
2277 for my $name ( keys %{$index_map} ) {
2279 my $identifier = $qualifier_ids->{ $name };
2281 next unless $identifier;
2283 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2284 $set_node->setAttribute( identifier => $identifier );
2285 $set_node->setAttribute( name => $name );
2287 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2288 for my $index ( sort keys %{$index_map->{$name}} ) {
2289 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2291 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2292 $map_node->appendChild( $name_node );
2294 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2296 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2297 $index_node->appendChild( $title_node );
2298 $index_node->appendChild( $map_node );
2300 $index_node->setAttribute( id => "$name.$index" );
2301 $title_node->appendText($index_map->{$name}{$index}{'title'});
2302 $name_node->setAttribute( set => $name );
2303 $name_node->appendText($index_map->{$name}{$index}{'index'});
2305 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2309 $$explain = $e->toString;
2313 SRU::Response::Record->new(
2314 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2315 recordData => $$explain
2321 sub return_auth_response {
2322 my ($cgi, $req, $resp) = @_;
2324 my $cql_query = decode_utf8($req->query);
2325 my $search = $req->cql->toEvergreenAuth;
2327 my $qualifier = decode_utf8($search->{qualifier});
2328 my $term = decode_utf8($search->{term});
2330 $log->info("SRU NAF search string [$cql_query] converted to "
2331 . "[$qualifier:$term]\n");
2333 my $page_size = $req->maximumRecords;
2336 # startwith deals with pages, so convert startRecord to a page number
2337 my $page = ($req->startRecord / $page_size) || 0;
2340 if ($qualifier eq "id") {
2341 $recs = [ int($term) ];
2343 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2345 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2346 $method .= ".refs" if $refs;
2348 $recs = $supercat->request(
2357 my $record_position = $req->startRecord;
2358 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2359 foreach my $record (@$recs) {
2360 my $marcxml = $cstore->request(
2361 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2365 SRU::Response::Record->new(
2366 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2367 recordData => $marcxml,
2368 recordPosition => ++$record_position
2373 $resp->numberOfRecords(scalar(@$recs));
2376 =head2 get_ou($org_unit)
2378 Returns an aou object for a given actor.org_unit shortname or ID.
2383 my $org = shift || '-';
2387 $org_unit = $actor->request(
2388 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2390 } elsif ($org !~ /^\d+$/o) {
2391 $org_unit = $actor->request(
2392 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2395 $org_unit = $actor->request(
2396 'open-ils.actor.org_unit_list.search' => id => $org