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 OpenSRF::Utils::Logger qw/$logger/;
28 use OpenILS::Application::AppUtils;
29 use OpenILS::Utils::TagURI;
32 use MARC::File::XML ( BinaryEncoding => 'UTF-8' );
34 my $log = 'OpenSRF::Utils::Logger';
35 my $U = 'OpenILS::Application::AppUtils';
37 # set the bootstrap config when this module is loaded
38 my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
40 my $authority_axis_re = qr/^authority\.(\w+)(\.refs)?$/;
42 my %extra_header_action_per_type = (
44 {"Content-Disposition" =>
45 sub { "attachment;filename=" . time . ".mrc"}}
49 $browse_types{call_number}{xml} = sub {
52 my $year = (gmtime())[5] + 1900;
55 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
58 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
59 $cn_class =~ s/Fieldmapper-//gso;
61 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
62 my $cn_lib = $cn->owning_lib->shortname;
63 my $cn_label = $cn->label;
64 my $cn_prefix = $cn->prefix->label;
65 my $cn_suffix = $cn->suffix->label;
67 $cn_label =~ s/\n//gos;
68 $cn_label =~ s/&/&/go;
69 $cn_label =~ s/'/'/go;
70 $cn_label =~ s/</</go;
71 $cn_label =~ s/>/>/go;
73 $cn_prefix =~ s/\n//gos;
74 $cn_prefix =~ s/&/&/go;
75 $cn_prefix =~ s/'/'/go;
76 $cn_prefix =~ s/</</go;
77 $cn_prefix =~ s/>/>/go;
79 $cn_suffix =~ s/\n//gos;
80 $cn_suffix =~ s/&/&/go;
81 $cn_suffix =~ s/'/'/go;
82 $cn_suffix =~ s/</</go;
83 $cn_suffix =~ s/>/>/go;
85 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
86 $ou_class =~ s/Fieldmapper-//gso;
88 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
89 my $ou_name = $cn->owning_lib->name;
91 $ou_name =~ s/\n//gos;
92 $ou_name =~ s/'/'/go;
94 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
95 $rec_class =~ s/Fieldmapper-//gso;
97 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
99 $content .= "<volume id='$cn_tag' lib='$cn_lib' prefix='$cn_prefix' label='$cn_label' suffix='$cn_suffix'>\n";
100 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
102 my $r_doc = $parser->parse_string($cn->record->marc);
103 $r_doc->documentElement->setAttribute( id => $rec_tag );
104 $content .= $U->entityize($r_doc->documentElement->toString);
106 $content .= "</volume>\n";
109 $content .= "</volumes>\n";
110 return ("Content-type: application/xml\n\n",$content);
114 $browse_types{call_number}{html} = sub {
119 if (!$cn_browse_xslt) {
120 $cn_browse_xslt = $parser->parse_file(
121 OpenSRF::Utils::SettingsClient
123 ->config_value( dirs => 'xsl' ).
126 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
129 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
132 "Content-type: text/html\n\n",
134 $cn_browse_xslt->transform(
135 $parser->parse_string( $xml ),
150 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
152 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
153 Fieldmapper->import(IDL => $idl);
155 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
156 $actor = OpenSRF::AppSession->create('open-ils.actor');
157 $search = OpenSRF::AppSession->create('open-ils.search');
158 $parser = new XML::LibXML;
159 $xslt = new XML::LibXSLT;
161 $cn_browse_xslt = $parser->parse_file(
162 OpenSRF::Utils::SettingsClient
164 ->config_value( dirs => 'xsl' ).
168 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
170 %qualifier_map = %{$supercat
171 ->request("open-ils.supercat.biblio.search_aliases")
174 my %attribute_desc = (
175 site => 'Evergreen Site Code (shortname)',
176 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
177 dir => 'Sort direction (asc|desc)',
178 available => 'Filter to available (true|false)',
181 # Append the non-search-alias attributes to the qualifier map
198 preferred_language_weight
199 preferred_language_multiplier
201 $qualifier_map{'eg'}{$_}{'index'} = $_;
202 if (exists $attribute_desc{$_}) {
203 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
205 $qualifier_map{'eg'}{$_}{'title'} = $_;
210 ->request("open-ils.supercat.record.formats")
213 $list = [ map { (keys %$_)[0] } @$list ];
214 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
216 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
217 for my $record_browse_format ( @$list ) {
219 my $__f = $record_browse_format;
220 my $__a = $browse_axis;
222 $browse_types{$__a}{$__f} = sub {
223 my $record_list = shift;
226 my $real_format = shift || $__f;
231 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
232 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
233 $feed->root( "$base/../" );
235 $feed->link( next => $next => $feed->type );
236 $feed->link( previous => $prev => $feed->type );
239 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
247 my $auth_axes = $supercat
248 ->request("open-ils.supercat.authority.browse_axis_list")
252 for my $axis ( @$auth_axes ) {
253 my $basic_axis = 'authority.' . $axis;
254 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
257 my $__a = $browse_axis;
259 $browse_types{$__a}{$__f} = sub {
260 my $record_list = shift;
263 my $real_format = shift || $__f;
268 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
269 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
270 $feed->root( "$base/../" );
271 $feed->link( next => $next => $feed->type );
272 $feed->link( previous => $prev => $feed->type );
275 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
282 return Apache2::Const::OK;
285 sub check_child_init() {
286 if (!defined $supercat || !defined $actor || !defined $search) {
287 # For some reason one (or more) of our appsessions is missing....
293 =head2 parse_feed_type($type)
295 Determines whether and how a given feed type needs to be "fleshed out"
296 with holdings information.
298 The feed type could end with the string "-full", in which case we want
299 to return call numbers, copies, and URIS.
301 Or the feed type could end with "-uris", in which case we want to return
302 call numbers and URIS.
304 Otherwise, we won't return any holdings.
308 sub parse_feed_type {
309 my $type = shift || '';
311 if ($type =~ /-full$/o) {
315 if ($type =~ /-uris$/o) {
319 # Otherwise, we'll return just the facts, ma'am
323 =head2 supercat_format($format_hashref, $format_type)
325 Given a reference to a hash containing the namespace_uri,
326 docs, and schema location attributes for a set of formats,
327 generate the XML description required by the supercat service.
329 We derive the base type from the format type so that we do not
330 have to populate the hash with redundant information.
334 sub supercat_format {
338 (my $base_type = $type) =~ s/(-full|-uris)$//o;
340 my $format = "<format><name>$type</name><type>application/xml</type>";
342 for my $part ( qw/namespace_uri docs schema_location/ ) {
343 $format .= "<$part>$$h{$base_type}{$part}</$part>"
344 if ($$h{$base_type}{$part});
347 $format .= '</format>';
352 =head2 unapi_format($format_hashref, $format_type)
354 Given a reference to a hash containing the namespace_uri,
355 docs, and schema location attributes for a set of formats,
356 generate the XML description required by the supercat service.
358 We derive the base type from the format type so that we do not
359 have to populate the hash with redundant information.
367 (my $base_type = $type) =~ s/(-full|-uris)$//o;
369 my $format = "<format name='$type' type='application/xml'";
371 for my $part ( qw/namespace_uri docs schema_location/ ) {
372 $format .= " $part='$$h{$base_type}{$part}'"
373 if ($$h{$base_type}{$part});
382 # Return a list of strings suitable for printing on STDOUT as HTTP headers.
383 sub extra_headers_per_type_to_string {
385 if (my $list = $extra_header_action_per_type{$type}) {
387 my $str = (keys(%$_))[0] . ": ";
388 my $value = (values(%$_))[0];
389 if (ref $value eq 'CODE') {
392 return $str . $value . "\n";
398 # Return key/value pairs suitable for feeding into CGI::header()
399 sub extra_headers_per_type_to_cgi {
402 if (my $list = $extra_header_action_per_type{$type}) {
404 my $key = (keys(%$_))[0];
405 my $value = (values(%$_))[0];
406 if (ref $value eq 'CODE') {
409 return $key => $value;
418 return Apache2::Const::DECLINED if (-e $apache->filename);
422 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
425 ->request("open-ils.supercat.oisbn", $isbn)
428 print "Content-type: application/xml; charset=utf-8\n\n";
429 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
431 unless (exists $$list{metarecord}) {
433 return Apache2::Const::OK;
436 print "<idlist metarecord='$$list{metarecord}'>\n";
438 for ( keys %{ $$list{record_list} } ) {
439 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
440 print " <isbn record='$_'>$o</isbn>\n"
445 return Apache2::Const::OK;
453 my $ctype = 'application/xml';
454 # Only bre and biblio_record_entry_feed have tranforms, but we'll ignore that for now
455 if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/ and $format ne 'xml') {
456 # XXX set $ctype to something else
459 print "Content-type: $ctype; charset=utf-8\n\n";
460 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
462 $supercat->request("open-ils.supercat.u2", $u2->toURI, $format)
466 return Apache2::Const::OK;
473 print "Content-type: application/xml; charset=utf-8\n\n";
474 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
476 if ($u2->classname =~ /^(?:bre|biblio_record_entry_feed)$/) {
477 # TODO: if/when unapi.bre_output_layout becomes something
478 # that actually changes, the hard-coding here should be
482 <format name="holdings_xml" type="application/xml"/>
483 <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"/>
484 <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"/>
490 <format name="xml" type="application/xml"/>
495 return Apache2::Const::OK;
501 return Apache2::Const::DECLINED if (-e $apache->filename);
508 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
509 my $rel_name = $cgi->url(-relative=>1);
510 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
513 my $url = $cgi->url(-path_info=>$add_path);
514 my $root = (split 'unapi', $url)[0];
515 my $base = (split 'unapi', $url)[0] . 'unapi';
518 my $uri = $cgi->param('id') || '';
520 my $format = $cgi->param('format') || '';
521 (my $base_format = $format) =~ s/(-full|-uris)$//o;
522 my $u2uri = OpenILS::Utils::TagURI->new($uri);
523 if ($u2uri->version > 1) {
525 return unapi2($apache, $u2uri, $format);
527 return unapi2_formats($apache, $u2uri);
531 my $host = $cgi->virtual_host || $cgi->server_name;
533 my $skin = $cgi->param('skin') || 'default';
534 my $locale = $cgi->param('locale') || 'en-US';
536 # Enable localized results of copy status, etc
537 $supercat->session_locale($locale);
539 my $flesh_feed = parse_feed_type($format);
540 ($base_format = $format) =~ s/(-full|-uris)$//o;
541 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
542 my $body = "Content-type: application/xml; charset=utf-8\n\n";
544 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
547 ($lib,$depth) = split('/', $4);
548 $type = 'metarecord' if ($1 =~ /^m/o);
549 $type = 'authority' if ($1 =~ /^authority/o);
553 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
556 ->request("open-ils.supercat.$type.formats")
559 if ($type eq 'record' or $type eq 'isbn') {
560 $body .= <<" FORMATS";
562 <format name='opac' type='text/html'/>
563 <format name='html' type='text/html'/>
564 <format name='htmlholdings' type='text/html'/>
565 <format name='holdings_xml' type='application/xml'/>
566 <format name='holdings_xml-full' type='application/xml'/>
567 <format name='html-full' type='text/html'/>
568 <format name='htmlholdings-full' type='text/html'/>
569 <format name='marctxt' type='text/plain'/>
570 <format name='ris' type='text/plain'/>
572 } elsif ($type eq 'metarecord') {
573 $body .= <<" FORMATS";
575 <format name='opac' type='text/html'/>
578 $body .= <<" FORMATS";
584 my ($type) = keys %$h;
585 $body .= unapi_format($h, $type);
587 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
588 $body .= unapi_format($h, "$type-full");
589 $body .= unapi_format($h, "$type-uris");
593 $body .= "</formats>\n";
597 ->request("open-ils.supercat.$type.formats")
602 ->request("open-ils.supercat.metarecord.formats")
606 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
607 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
609 $body .= <<" FORMATS";
611 <format name='opac' type='text/html'/>
612 <format name='html' type='text/html'/>
613 <format name='htmlholdings' type='text/html'/>
614 <format name='holdings_xml' type='application/xml'/>
615 <format name='holdings_xml-full' type='application/xml'/>
616 <format name='html-full' type='text/html'/>
617 <format name='htmlholdings-full' type='text/html'/>
618 <format name='marctxt' type='text/plain'/>
619 <format name='ris' type='text/plain'/>
624 my ($type) = keys %$h;
625 $body .= "\t" . unapi_format($h, $type);
627 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
628 $body .= "\t" . unapi_format($h, "$type-full");
629 $body .= "\t" . unapi_format($h, "$type-uris");
633 $body .= "</formats>\n";
637 return Apache2::Const::OK;
641 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
645 ($lib,$depth) = split('/', $4);
647 $type = 'metarecord' if ($scheme =~ /^metabib/o);
648 $type = 'isbn' if ($scheme =~ /^isbn/o);
649 $type = 'acp' if ($scheme =~ /^asset-copy/o);
650 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
651 $type = 'auri' if ($scheme =~ /^asset-uri/o);
652 $type = 'authority' if ($scheme =~ /^authority/o);
653 $command = 'retrieve';
654 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
655 $command = 'browse' if ($scheme =~ /^authority/);
659 $paging = [split ',', $paging];
664 if (!$lib || $lib eq '-') {
665 $lib = $actor->request(
666 'open-ils.actor.org_unit_list.search' => parent_ou => undef
667 )->gather(1)->[0]->shortname;
670 my ($lib_object,$lib_id,$ou_types,$lib_depth);
671 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
672 $lib_object = $actor->request(
673 'open-ils.actor.org_unit_list.search' => shortname => $lib
675 $lib_id = $lib_object->id;
677 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
678 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
681 if ($command eq 'browse') {
682 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
686 if ($type eq 'isbn') {
687 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
689 # Escape user input before display
690 $command = CGI::escapeHTML($command);
691 $id = CGI::escapeHTML($id);
692 $type = CGI::escapeHTML($type);
693 $format = CGI::escapeHTML(decode_utf8($format));
695 print "Content-type: text/html; charset=utf-8\n\n";
696 $apache->custom_response( 404, <<" HTML");
699 <title>Type [$type] with id [$id] not found!</title>
703 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
714 { (keys(%$_))[0] eq $base_format }
715 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
717 { $_ eq $base_format }
718 qw/opac html htmlholdings marctxt ris holdings_xml/
720 # Escape user input before display
721 $format = CGI::escapeHTML($format);
722 $type = CGI::escapeHTML($type);
724 print "Content-type: text/html; charset=utf-8\n\n";
725 $apache->custom_response( 406, <<" HTML");
728 <title>Invalid format [$format] for type [$type]!</title>
732 <center>Sorry, format $format is not valid for type $type.</center>
739 if ($format eq 'opac') {
740 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
741 if ($type eq 'metarecord');
742 print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
743 if ($type eq 'record');
745 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
746 my $feed = create_record_feed(
757 # Escape user input before display
758 $command = CGI::escapeHTML($command);
759 $id = CGI::escapeHTML($id);
760 $type = CGI::escapeHTML($type);
761 $format = CGI::escapeHTML(decode_utf8($format));
763 print "Content-type: text/html; charset=utf-8\n\n";
764 $apache->custom_response( 404, <<" HTML");
767 <title>Type [$type] with id [$id] not found!</title>
771 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
779 $feed->creator($host);
781 $feed->link( unapi => $base) if ($flesh_feed);
783 print "Content-type: ". $feed->type ."; charset=utf-8\n";
785 print $_ for extra_headers_per_type_to_string($type);
787 print "\n", $feed->toString, "\n";
789 return Apache2::Const::OK;
792 my $method = "open-ils.supercat.$type.$base_format.$command";
794 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
796 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
797 # however, we can have it carry extra options like no_record! (comma separated)
798 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
800 my $req = $supercat->request($method,@params);
801 my $data = $req->gather();
803 if ($req->failed || !$data) {
804 # Escape user input before display
805 $command = CGI::escapeHTML($command);
806 $id = CGI::escapeHTML($id);
807 $type = CGI::escapeHTML($type);
808 $format = CGI::escapeHTML(decode_utf8($format));
810 print "Content-type: text/html; charset=utf-8\n\n";
811 $apache->custom_response( 404, <<" HTML");
814 <title>$type $id not found!</title>
818 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
825 print "Content-type: application/xml; charset=utf-8\n\n";
827 # holdings_xml format comes back to us without an XML declaration
828 # and without being entityized; fix that here
829 if ($base_format eq 'holdings_xml') {
830 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
831 print $U->entityize($data);
833 while (my $c = $req->recv) {
834 print $U->entityize($c->content);
840 return Apache2::Const::OK;
846 return Apache2::Const::DECLINED if (-e $apache->filename);
853 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
854 my $rel_name = $cgi->url(-relative=>1);
855 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
858 my $url = $cgi->url(-path_info=>$add_path);
859 my $root = (split 'supercat', $url)[0];
860 my $base = (split 'supercat', $url)[0] . 'supercat';
861 my $unapi = (split 'supercat', $url)[0] . 'unapi';
863 my $host = $cgi->virtual_host || $cgi->server_name;
865 my $path = $cgi->path_info;
866 my ($id,$type,$format,$command) = reverse split '/', $path;
867 my $flesh_feed = parse_feed_type($format);
868 (my $base_format = $format) =~ s/(-full|-uris)$//o;
870 my $skin = $cgi->param('skin') || 'default';
871 my $locale = $cgi->param('locale') || 'en-US';
873 # Enable localized results of copy status, etc
874 $supercat->session_locale($locale);
876 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
877 print "Content-type: application/xml; charset=utf-8\n";
880 ->request("open-ils.supercat.$1.formats")
888 <type>text/html</type>
891 if ($1 eq 'record' or $1 eq 'isbn') {
893 <name>htmlholdings</name>
894 <type>text/html</type>
898 <type>text/html</type>
901 <name>htmlholdings-full</name>
902 <type>text/html</type>
905 <name>html-full</name>
906 <type>text/html</type>
910 <type>text/plain</type>
914 <type>text/plain</type>
919 my ($type) = keys %$h;
920 print supercat_format($h, $type);
922 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
923 print supercat_format($h, "$type-full");
924 print supercat_format($h, "$type-uris");
929 print "</formats>\n";
931 return Apache2::Const::OK;
935 ->request("open-ils.supercat.record.formats")
940 ->request("open-ils.supercat.metarecord.formats")
944 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
945 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
950 <type>text/html</type>
953 <name>htmlholdings</name>
954 <type>text/html</type>
958 <type>text/html</type>
961 <name>htmlholdings-full</name>
962 <type>text/html</type>
965 <name>html-full</name>
966 <type>text/html</type>
970 <type>text/plain</type>
974 <type>text/plain</type>
978 my ($type) = keys %$h;
979 print supercat_format($h, $type);
981 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
982 print supercat_format($h, "$type-full");
983 print supercat_format($h, "$type-uris");
988 print "</formats>\n";
991 return Apache2::Const::OK;
994 if ($format eq 'opac') {
995 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
996 if ($type eq 'metarecord');
997 print "Location: /eg/opac/record/$id\n\n"
998 if ($type eq 'record');
1001 } elsif ($base_format eq 'marc21') {
1005 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
1007 print "Content-type: application/octet-stream\n";
1008 print $_ for extra_headers_per_type_to_string($base_format);
1009 print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
1014 # Escape user input before display
1015 $id = CGI::escapeHTML($id);
1017 print "Content-type: text/html; charset=utf-8\n\n";
1018 $apache->custom_response( 404, <<" HTML");
1021 <title>ERROR</title>
1025 <center>Couldn't fetch $id as MARC21.</center>
1032 return Apache2::Const::OK;
1034 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
1035 my $feed = create_record_feed(
1038 undef, undef, undef,
1043 $feed->creator($host);
1047 $feed->link( unapi => $base) if ($flesh_feed);
1049 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1051 print $_ for extra_headers_per_type_to_string($type);
1053 print "\n", $feed->toString, "\n";
1055 return Apache2::Const::OK;
1058 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
1059 $req->wait_complete;
1062 # Escape user input before display
1063 $command = CGI::escapeHTML($command);
1064 $id = CGI::escapeHTML($id);
1065 $type = CGI::escapeHTML($type);
1066 $format = CGI::escapeHTML(decode_utf8($format));
1068 print "Content-type: text/html; charset=utf-8\n\n";
1069 $apache->custom_response( 404, <<" HTML");
1072 <title>$type $id not found!</title>
1076 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
1083 print "Content-type: application/xml; charset=utf-8\n\n";
1084 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
1086 return Apache2::Const::OK;
1092 return Apache2::Const::DECLINED if (-e $apache->filename);
1098 my $year = (gmtime())[5] + 1900;
1099 my $host = $cgi->virtual_host || $cgi->server_name;
1102 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1103 my $rel_name = $cgi->url(-relative=>1);
1104 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1107 my $url = $cgi->url(-path_info=>$add_path);
1108 my $root = (split 'feed', $url)[0] . '/';
1109 my $base = (split 'bookbag', $url)[0] . '/bookbag';
1110 my $unapi = (split 'feed', $url)[0] . '/unapi';
1112 my $skin = $cgi->param('skin') || 'default';
1113 my $locale = $cgi->param('locale') || 'en-US';
1114 my $org = $cgi->param('searchOrg');
1116 # Enable localized results of copy status, etc
1117 $supercat->session_locale($locale);
1119 my $org_unit = get_ou($org);
1120 my $scope = "l=" . $org_unit->[0]->id . "&";
1122 $root =~ s{(?<!http:)//}{//}go;
1123 $base =~ s{(?<!http:)//}{//}go;
1124 $unapi =~ s{(?<!http:)//}{//}go;
1126 my $path = $cgi->path_info;
1127 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1129 my ($id,$type) = reverse split '/', $path;
1130 my $flesh_feed = parse_feed_type($type);
1132 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1133 return Apache2::Const::NOT_FOUND unless($bucket);
1135 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1136 if (lc($type) eq 'opac') {
1137 print "Location: /eg/opac/results?bookbag=$id\n\n";
1141 # last created first
1142 my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1144 my $feed = create_record_feed(
1147 [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1149 $org_unit->[0]->shortname,
1154 $feed->id($bucket_tag);
1156 $feed->title($bucket->name);
1157 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1158 $feed->creator($host);
1161 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1162 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1163 $feed->link(opac => $base . "/opac/$id" => 'text/html');
1164 $feed->link(OPAC => $base . "/opac/$id" => 'text/html');
1165 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1166 $feed->link(unapi => $unapi);
1168 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1169 print $feed->toString . "\n";
1171 return Apache2::Const::OK;
1176 return Apache2::Const::DECLINED if (-e $apache->filename);
1182 my $year = (gmtime())[5] + 1900;
1183 my $host = $cgi->virtual_host || $cgi->server_name;
1186 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1187 my $rel_name = $cgi->url(-relative=>1);
1188 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1191 my $url = $cgi->url(-path_info=>$add_path);
1192 my $root = (split 'feed', $url)[0];
1193 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1194 my $unapi = (split 'feed', $url)[0] . 'unapi';
1196 my $skin = $cgi->param('skin') || 'default';
1197 my $locale = $cgi->param('locale') || 'en-US';
1198 my $org = $cgi->param('searchOrg');
1200 # Enable localized results of copy status, etc
1201 $supercat->session_locale($locale);
1203 my $org_unit = get_ou($org);
1204 my $scope = "l=" . $org_unit->[0]->id . "&";
1206 my $path = $cgi->path_info;
1207 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1209 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1211 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1212 my $flesh_feed = parse_feed_type($type);
1215 $limit = 10 if $limit !~ /^\d+$/;
1217 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1219 if (lc($type) eq 'opac') {
1220 print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
1224 my $search = 'record';
1225 if ($rtype eq 'authority') {
1226 $search = 'authority';
1228 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1232 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1234 $feed->title("$limit most recent $rtype ${axis}s");
1237 $feed->creator($host);
1240 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1241 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1242 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1243 $feed->link(unapi => $unapi);
1247 "http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
1252 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1254 print $_ for extra_headers_per_type_to_string($type);
1256 print "\n", $feed->toString, "\n";
1258 return Apache2::Const::OK;
1261 sub opensearch_osd {
1262 my $version = shift;
1268 if ($version eq '1.0') {
1270 Content-type: application/opensearchdescription+xml; charset=utf-8
1272 <?xml version="1.0" encoding="UTF-8"?>
1273 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1274 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1275 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1276 <ShortName>$lib</ShortName>
1277 <LongName>Search $lib</LongName>
1278 <Description>Search the $lib OPAC by $class.</Description>
1279 <Tags>$lib book library</Tags>
1280 <SampleSearch>harry+potter</SampleSearch>
1281 <Developer>Mike Rylander for GPLS/PINES</Developer>
1282 <Contact>feedback\@open-ils.org</Contact>
1283 <SyndicationRight>open</SyndicationRight>
1284 <AdultContent>false</AdultContent>
1285 </OpenSearchDescription>
1289 Content-type: application/opensearchdescription+xml; charset=utf-8
1291 <?xml version="1.0" encoding="UTF-8"?>
1292 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1293 <ShortName>$lib</ShortName>
1294 <Description>Search the $lib OPAC by $class.</Description>
1295 <Tags>$lib book library</Tags>
1296 <Url type="application/rss+xml"
1297 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1298 <Url type="application/atom+xml"
1299 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1300 <Url type="application/x-mods3+xml"
1301 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1302 <Url type="application/x-mods+xml"
1303 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1304 <Url type="application/octet-stream"
1305 template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1306 <Url type="application/x-marcxml+xml"
1307 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1308 <Url type="text/html"
1309 template="https://$host/eg/opac/results?locg=$lib;query={searchTerms};page={startPage?};startIndex={startIndex?};count={count?};searchLang={language?}"/>
1310 <LongName>Search $lib</LongName>
1311 <Query role="example" searchTerms="harry+potter" />
1312 <Developer>Mike Rylander for GPLS/PINES</Developer>
1313 <Contact>feedback\@open-ils.org</Contact>
1314 <SyndicationRight>open</SyndicationRight>
1315 <AdultContent>false</AdultContent>
1316 <Language>en-US</Language>
1317 <OutputEncoding>UTF-8</OutputEncoding>
1318 <InputEncoding>UTF-8</InputEncoding>
1319 </OpenSearchDescription>
1323 return Apache2::Const::OK;
1326 sub opensearch_feed {
1328 return Apache2::Const::DECLINED if (-e $apache->filename);
1333 my $year = (gmtime())[5] + 1900;
1335 my $host = $cgi->virtual_host || $cgi->server_name;
1338 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1339 my $rel_name = $cgi->url(-relative=>1);
1340 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1343 my $url = $cgi->url(-path_info=>$add_path);
1344 my $root = (split 'opensearch', $url)[0];
1345 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1346 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1348 my $path = $cgi->path_info;
1349 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1351 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1357 if (!$lib || $lib eq '-') {
1358 $lib = $actor->request(
1359 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1360 )->gather(1)->[0]->shortname;
1363 if ($class eq '-') {
1367 return opensearch_osd($version, $lib, $class, $base, $host);
1371 my $page = $cgi->param('startPage') || 1;
1372 my $offset = $cgi->param('startIndex') || 1;
1373 my $limit = $cgi->param('count') || 10;
1375 $page = 1 if ($page !~ /^\d+$/);
1376 $offset = 1 if ($offset !~ /^\d+$/);
1377 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1380 $offset = ($page - 1) * $limit;
1385 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1386 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1388 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1389 $lang = '' if ($lang eq '*');
1391 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1393 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1396 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1397 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1399 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1402 $type = $cgi->param('responseType') if $cgi->param('responseType');
1405 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1409 my $kwt = $cgi->param('kw');
1410 my $tit = $cgi->param('ti');
1411 my $aut = $cgi->param('au');
1412 my $sut = $cgi->param('su');
1413 my $set = $cgi->param('se');
1415 $terms .= " " if ($terms && $kwt);
1416 $terms .= "keyword: $kwt" if ($kwt);
1417 $terms .= " " if ($terms && $tit);
1418 $terms .= "title: $tit" if ($tit);
1419 $terms .= " " if ($terms && $aut);
1420 $terms .= "author: $aut" if ($aut);
1421 $terms .= " " if ($terms && $sut);
1422 $terms .= "subject: $sut" if ($sut);
1423 $terms .= " " if ($terms && $set);
1424 $terms .= "series: $set" if ($set);
1426 if ($version eq '1.0') {
1428 } elsif ($type eq '-') {
1431 my $flesh_feed = parse_feed_type($type);
1433 $terms = decode_utf8($terms);
1434 $lang = 'eng' if ($lang eq 'en-US');
1436 $log->debug("OpenSearch terms: $terms");
1438 my $org_unit = get_ou($org);
1440 my $safe_terms = $terms;
1442 # XXX Apostrophes used to break search, but no longer do. The following
1443 # XXX line breaks phrase searching in OpenSearch, and should be removed.
1444 $safe_terms =~ s{'}{ }go;
1446 my $query_terms = 'site('.$org_unit->[0]->shortname.") $safe_terms";
1447 $query_terms = "sort($sort) $query_terms" if ($sort);
1448 $query_terms = "language($lang) $query_terms" if ($lang);
1449 $query_terms = "#$sortdir $query_terms" if ($sortdir);
1451 my $recs = $search->request(
1452 'open-ils.search.biblio.multiclass.query' => {
1455 } => $query_terms => 1
1458 $log->debug("Hits for [$terms]: $recs->{count}");
1460 my $feed = create_record_feed(
1463 [ map { $_->[0] } @{$recs->{ids}} ],
1470 $log->debug("Feed created...");
1474 $feed->search($safe_terms);
1475 $feed->class($class);
1477 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1479 $feed->creator($host);
1482 $feed->_create_node(
1483 $feed->{item_xpath},
1484 'http://a9.com/-/spec/opensearch/1.1/',
1489 $feed->_create_node(
1490 $feed->{item_xpath},
1491 'http://a9.com/-/spec/opensearch/1.1/',
1496 $feed->_create_node(
1497 $feed->{item_xpath},
1498 'http://a9.com/-/spec/opensearch/1.1/',
1503 $log->debug("...basic feed data added...");
1507 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1508 'application/opensearch+xml'
1509 ) if ($offset + $limit < $recs->{count});
1513 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1514 'application/opensearch+xml'
1519 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1520 'application/opensearch+xml'
1525 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1526 'application/rss+xml'
1531 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1532 'application/atom+xml'
1537 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1543 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1547 $feed->link( 'unapi-server' => $unapi);
1549 $log->debug("...feed links added...");
1553 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1554 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1558 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1560 -type => $feed->type, -charset => 'UTF-8',
1561 extra_headers_per_type_to_cgi($type)
1562 ), $feed->toString, "\n";
1564 $log->debug("...and feed returned.");
1566 return Apache2::Const::OK;
1569 sub create_record_feed {
1572 my $records = shift;
1575 my $lib = uc(shift()) || '-';
1582 my $base = $cgi->url;
1583 my $host = $cgi->virtual_host || $cgi->server_name;
1585 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1589 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1591 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1593 $type =~ s/(-full|-uris)$//o;
1595 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1596 $feed->base($base) if ($flesh);
1597 $feed->unapi($unapi) if ($flesh);
1599 $type = 'atom' if ($type eq 'html');
1600 $type = 'marcxml' if
1601 $type eq 'htmlholdings' or
1602 $type eq 'marctxt' or
1604 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1606 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1609 for my $record (@$records) {
1610 next unless($record);
1612 #my $rec = $record->id;
1615 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1616 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1617 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1618 $item_tag .= "/$depth" if (defined($depth));
1620 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1622 my $xml = $supercat->request(
1623 "open-ils.supercat.$search.$type.retrieve",
1628 my $node = $feed->add_item($xml);
1632 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1633 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1634 while ( !$r->complete ) {
1635 $xml .= join('', map {$_->content} $r->recv);
1637 $xml .= join('', map {$_->content} $r->recv);
1638 $node->add_holdings($xml);
1641 $node->id($item_tag);
1642 #$node->update_ts(clean_ISO8601($record->edit_date));
1643 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1644 $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1645 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1646 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1647 $node->link('unapi-id' => $item_tag) if ($flesh);
1655 return Apache2::Const::DECLINED if (-e $apache->filename);
1660 my $year = (gmtime())[5] + 1900;
1662 my $host = $cgi->virtual_host || $cgi->server_name;
1665 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1666 my $rel_name = $cgi->url(-relative=>1);
1667 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1670 my $url = $cgi->url(-path_info=>$add_path);
1671 my $root = (split 'browse', $url)[0];
1672 my $base = (split 'browse', $url)[0] . 'browse';
1673 my $unapi = (split 'browse', $url)[0] . 'unapi';
1675 my $path = $cgi->path_info;
1678 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1679 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1681 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1683 my $status = [$cgi->param('status')];
1684 my $cpLoc = [$cgi->param('copyLocation')];
1685 $site ||= $cgi->param('searchOrg');
1686 $page ||= $cgi->param('startPage') || 0;
1687 $page_size ||= $cgi->param('count') || 9;
1688 $thesauruses //= '';
1689 $thesauruses =~ s/\s//g;
1690 # protect against cats bouncing on the comma key...
1691 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1693 $page = 0 if ($page !~ /^-?\d+$/);
1694 $page_size = 9 if $page_size !~ /^\d+$/;
1696 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1697 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1699 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1700 warn "something's wrong...";
1701 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1705 $string = decode_utf8($string);
1706 $string =~ s/\+/ /go;
1710 if ($axis =~ /^authority/) {
1711 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1713 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1714 $method .= ".refs" if $refs;
1716 $tree = $supercat->request(
1725 $tree = $supercat->request(
1726 "open-ils.supercat.$axis.browse",
1736 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1738 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1739 print $header.$content;
1740 return Apache2::Const::OK;
1743 sub string_startwith {
1745 return Apache2::Const::DECLINED if (-e $apache->filename);
1750 my $year = (gmtime())[5] + 1900;
1752 my $host = $cgi->virtual_host || $cgi->server_name;
1755 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1756 my $rel_name = $cgi->url(-relative=>1);
1757 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1760 my $url = $cgi->url(-path_info=>$add_path);
1761 my $root = (split 'startwith', $url)[0];
1762 my $base = (split 'startwith', $url)[0] . 'startwith';
1763 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1765 my $path = $cgi->path_info;
1768 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1769 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1771 my $status = [$cgi->param('status')];
1772 my $cpLoc = [$cgi->param('copyLocation')];
1773 $site ||= $cgi->param('searchOrg');
1774 $page ||= $cgi->param('startPage') || 0;
1775 $page_size ||= $cgi->param('count') || 9;
1776 $thesauruses //= '';
1777 $thesauruses =~ s/\s//g;
1778 # protect against cats bouncing on the comma key...
1779 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1781 $page = 0 if ($page !~ /^-?\d+$/);
1782 $page_size = 9 if $page_size !~ /^\d+$/;
1784 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1785 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1787 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1788 warn "something's wrong...";
1789 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1793 $string = decode_utf8($string);
1794 $string =~ s/\+/ /go;
1798 if ($axis =~ /^authority/) {
1799 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1801 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1802 $method .= ".refs" if $refs;
1804 $tree = $supercat->request(
1813 $tree = $supercat->request(
1814 "open-ils.supercat.$axis.startwith",
1824 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1826 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1827 print $header.$content;
1828 return Apache2::Const::OK;
1831 sub item_age_browse {
1833 return Apache2::Const::DECLINED if (-e $apache->filename);
1838 my $year = (gmtime())[5] + 1900;
1840 my $host = $cgi->virtual_host || $cgi->server_name;
1843 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1844 my $rel_name = $cgi->url(-relative=>1);
1845 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1848 my $url = $cgi->url(-path_info=>$add_path);
1849 my $root = (split 'browse', $url)[0];
1850 my $base = (split 'browse', $url)[0] . 'browse';
1851 my $unapi = (split 'browse', $url)[0] . 'unapi';
1853 my $path = $cgi->path_info;
1856 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1857 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1859 unless ($axis eq 'item-age') {
1860 warn "something's wrong...";
1861 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1865 my $status = [$cgi->param('status')];
1866 my $cpLoc = [$cgi->param('copyLocation')];
1867 $site ||= $cgi->param('searchOrg') || '-';
1868 $page ||= $cgi->param('startPage') || 1;
1869 $page_size ||= $cgi->param('count') || 10;
1871 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1872 $page_size = 10 if $page_size !~ /^\d+$/;
1874 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1875 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1877 my $recs = $supercat->request(
1878 "open-ils.supercat.new_book_list",
1886 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1888 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1889 print $header.$content;
1890 return Apache2::Const::OK;
1893 our %qualifier_ids = (
1894 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1895 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1896 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1900 # Our authority search options are currently pretty impoverished;
1901 # just right-truncated string match on a few categories, or by
1903 our %nested_auth_qualifier_map = (
1905 id => { index => 'id', title => 'Record number'},
1906 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1907 title => { index => 'title', title => 'Uniform title'},
1908 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1909 topic => { index => 'topic', title => 'Topical term'},
1913 my $base_explain = <<XML;
1915 id="evergreen-sru-explain-full"
1916 authoritative="true"
1917 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1918 xmlns="http://explain.z3950.org/dtd/2.0/">
1919 <serverInfo transport="http" protocol="SRU" version="1.1">
1926 <title primary="true"/>
1927 <description primary="true"/>
1931 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1936 identifier="info:srw/schema/1/marcxml-v1.1"
1937 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1941 <title>MARC21Slim (marcxml)</title>
1946 <default type="numberOfRecords">10</default>
1947 <default type="contextSet">eg</default>
1948 <default type="index">keyword</default>
1949 <default type="relation">all</default>
1950 <default type="sortSchema">marcxml</default>
1951 <default type="retrieveSchema">marcxml</default>
1952 <setting type="maximumRecords">50</setting>
1953 <supports type="relationModifier">relevant</supports>
1954 <supports type="relationModifier">stem</supports>
1955 <supports type="relationModifier">fuzzy</supports>
1956 <supports type="relationModifier">word</supports>
1969 my $req = SRU::Request->newFromCGI( $cgi );
1970 my $resp = SRU::Response->newFromRequest( $req );
1972 # Find the org_unit shortname, if passed as part of the URL
1973 # http://example.com/opac/extras/sru/SHORTNAME
1974 my $url = $cgi->path_info;
1975 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1977 if ( $resp->type eq 'searchRetrieve' ) {
1979 # Older versions of Debian packages returned terms to us double-encoded,
1980 # so we had to forcefully double-decode them a second time with
1981 # an outer decode('utf8', $string) call; this seems to be resolved with
1982 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1983 my $cql_query = decode_utf8($req->query);
1984 my $search_string = decode_utf8($req->cql->toEvergreen);
1986 # Ensure the search string overrides the default site
1987 if ($shortname and $search_string !~ m#site:#) {
1988 $search_string .= " site:$shortname";
1991 my $offset = $req->startRecord;
1992 $offset-- if ($offset);
1995 my $limit = $req->maximumRecords;
1998 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
2000 if (!$shortname || $shortname eq '-') {
2001 my $search_org = get_ou($shortname);
2002 $shortname = $search_org->[0]->shortname;
2005 my $recs = $search->request(
2006 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
2009 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2010 foreach my $rec (@{$recs->{ids}}) {
2011 my $rec_id = shift @$rec;
2012 my $data = $cstore->request(
2013 'open-ils.cstore.json_query' => {
2015 'unapi.bre', $rec_id,
2016 'marcxml', 'record',
2017 ($holdings) ? '{holdings_xml,acp}' : '{}',
2023 my $marcxml = XML::LibXML->load_xml( string => $data->{'unapi.bre'} );
2025 # process <holdings> element, if any
2027 for my $node ($marcxml->getElementsByTagName('holdings')) {
2028 for my $volume ($node->getElementsByTagName('volume')) {
2029 my $prefix = $volume->getChildrenByTagName('call_number_prefix')->[0]->getAttribute('label');
2030 my $suffix = $volume->getChildrenByTagName('call_number_suffix')->[0]->getAttribute('label');
2031 my $cn = $volume->getAttribute('label');
2032 my $owning_lib = $volume->getAttribute('lib');
2033 for my $copy ($volume->getElementsByTagName('copy')) {
2035 a => $copy->getChildrenByTagName('location')->[0]->textContent,
2038 d => $copy->getChildrenByTagName('circ_lib')->[0]->getAttribute('shortname'),
2039 g => $copy->getAttribute('barcode'),
2042 n => $copy->getChildrenByTagName('status')->[0]->textContent
2046 # remove <holdings> element
2047 $node->parentNode->removeChild($node);
2050 my $marc = MARC::Record->new_from_xml($marcxml->toString(), 'UTF8', 'XML');
2052 # Force record leader to 'a' as our data is always UTF8
2053 # Avoids marc8_to_utf8 from being invoked with horrible results
2054 # on the off-chance the record leader isn't correct
2055 my $ldr = $marc->leader;
2056 substr($ldr, 9, 1, 'a');
2057 $marc->leader($ldr);
2059 # Expects the record ID in the 001
2060 $marc->delete_field($_) for ($marc->field('001'));
2061 if (!$marc->field('001')) {
2062 $marc->insert_fields_ordered(
2063 MARC::Field->new( '001', $rec_id )
2067 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
2068 for my $copy (@copies) {
2069 $marc->insert_fields_ordered(
2077 ($copy->{k} ? (k => $copy->{k}) : ()),
2078 ($copy->{m} ? (m => $copy->{m}) : ()),
2084 my $output = $marc->as_xml_record();
2085 $output =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2087 SRU::Response::Record->new(
2088 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2089 recordData => $output,
2090 recordPosition => ++$offset
2094 } catch Error with {
2095 $log->error("Failed to process record for SRU search");
2099 $resp->numberOfRecords($recs->{count});
2101 } elsif ( $resp->type eq 'explain' ) {
2102 return_sru_explain($cgi, $req, $resp, \$ex_doc,
2104 \%OpenILS::WWW::SuperCat::qualifier_ids
2108 SRU::Response::Record->new(
2109 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2110 recordData => $ex_doc
2115 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2116 print $U->entityize($resp->asXML) . "\n";
2117 return Apache2::Const::OK;
2122 package CQL::BooleanNode;
2126 my $left = $self->left();
2127 my $right = $self->right();
2128 my $leftStr = $left->toEvergreen;
2129 my $rightStr = $right->toEvergreen();
2131 my $op = '||' if uc $self->op() eq 'OR';
2134 return "$leftStr $op $rightStr";
2137 sub toEvergreenAuth {
2138 return toEvergreen(shift);
2141 package CQL::TermNode;
2145 my $qualifier = $self->getQualifier();
2146 my $term = $self->getTerm();
2147 my $relation = $self->getRelation();
2151 my ($qset, $qname) = split(/\./, $qualifier);
2153 # Per http://www.loc.gov/standards/sru/specs/cql.html
2154 # "All parts of CQL are case insensitive [...] If any case insensitive
2155 # part of CQL is specified with both upper and lower case, it is for
2156 # aesthetic purposes only."
2158 # So fold the qualifier and relation to lower case
2160 $qname = lc($qname);
2162 if ( exists($qualifier_map{$qset}{$qname}) ) {
2163 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2164 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2167 my @modifiers = $relation->getModifiers();
2169 my $base = $relation->getBase();
2170 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2173 foreach my $m ( @modifiers ) {
2174 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2180 $quote_it = 0 if ( $base eq 'all' );
2181 $term = maybeQuote($term) if $quote_it;
2184 croak( "Evergreen doesn't support the $base relations" );
2192 return "$qualifier:$term";
2195 sub toEvergreenAuth {
2197 my $qualifier = $self->getQualifier();
2198 my $term = $self->getTerm();
2199 my $relation = $self->getRelation();
2203 my ($qset, $qname) = split(/\./, $qualifier);
2205 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2206 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2207 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2210 return { qualifier => $qualifier, term => $term };
2215 sub sru_auth_search {
2220 my $req = SRU::Request->newFromCGI( $cgi );
2221 my $resp = SRU::Response->newFromRequest( $req );
2223 if ( $resp->type eq 'searchRetrieve' ) {
2224 return_auth_response($cgi, $req, $resp);
2225 } elsif ( $resp->type eq 'explain' ) {
2226 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2227 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2228 \%OpenILS::WWW::SuperCat::qualifier_ids
2232 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2233 print $U->entityize($resp->asXML) . "\n";
2234 return Apache2::Const::OK;
2237 sub explain_header {
2240 my $host = $cgi->virtual_host || $cgi->server_name;
2243 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2244 my $rel_name = $cgi->url(-relative=>1);
2245 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2247 my $base = $cgi->url(-base=>1);
2248 my $url = $cgi->url(-path_info=>$add_path);
2249 $url =~ s/^$base\///o;
2251 my $doc = $parser->parse_string($base_explain);
2252 my $e = $doc->documentElement;
2253 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2254 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2255 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2260 sub return_sru_explain {
2261 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2263 $index_map ||= \%qualifier_map;
2265 my ($doc, $e) = explain_header($cgi);
2266 for my $name ( keys %{$index_map} ) {
2268 my $identifier = $qualifier_ids->{ $name };
2270 next unless $identifier;
2272 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2273 $set_node->setAttribute( identifier => $identifier );
2274 $set_node->setAttribute( name => $name );
2276 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2277 for my $index ( sort keys %{$index_map->{$name}} ) {
2278 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2280 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2281 $map_node->appendChild( $name_node );
2283 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2285 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2286 $index_node->appendChild( $title_node );
2287 $index_node->appendChild( $map_node );
2289 $index_node->setAttribute( id => "$name.$index" );
2290 $title_node->appendText($index_map->{$name}{$index}{'title'});
2291 $name_node->setAttribute( set => $name );
2292 $name_node->appendText($index_map->{$name}{$index}{'index'});
2294 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2298 $$explain = $e->toString;
2302 SRU::Response::Record->new(
2303 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2304 recordData => $$explain
2310 sub return_auth_response {
2311 my ($cgi, $req, $resp) = @_;
2313 my $cql_query = decode_utf8($req->query);
2314 my $search = $req->cql->toEvergreenAuth;
2316 my $qualifier = decode_utf8($search->{qualifier});
2317 my $term = decode_utf8($search->{term});
2319 $log->info("SRU NAF search string [$cql_query] converted to "
2320 . "[$qualifier:$term]\n");
2322 my $page_size = $req->maximumRecords;
2325 # startwith deals with pages, so convert startRecord to a page number
2326 my $page = ($req->startRecord / $page_size) || 0;
2329 if ($qualifier eq "id") {
2330 $recs = [ int($term) ];
2332 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2334 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2335 $method .= ".refs" if $refs;
2337 $recs = $supercat->request(
2346 my $record_position = $req->startRecord;
2347 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2348 foreach my $record (@$recs) {
2349 my $marcxml = $cstore->request(
2350 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2354 SRU::Response::Record->new(
2355 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2356 recordData => $marcxml,
2357 recordPosition => ++$record_position
2362 $resp->numberOfRecords(scalar(@$recs));
2365 =head2 get_ou($org_unit)
2367 Returns an aou object for a given actor.org_unit shortname or ID.
2372 my $org = shift || '-';
2376 $org_unit = $actor->request(
2377 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2379 } elsif ($org !~ /^\d+$/o) {
2380 $org_unit = $actor->request(
2381 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2384 $org_unit = $actor->request(
2385 'open-ils.actor.org_unit_list.search' => id => $org