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 OpenSRF::Utils 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 (my $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 # Apostrophes break search and get indexed as spaces anyway
1441 my $safe_terms = $terms;
1442 $safe_terms =~ s{'}{ }go;
1444 my $recs = $search->request(
1445 'open-ils.search.biblio.multiclass.query' => {
1446 org_unit => $org_unit->[0]->id,
1450 sort_dir => $sortdir,
1451 default_class => $class,
1452 ($lang ? ( 'language' => $lang ) : ()),
1453 } => $safe_terms => 1
1456 $log->debug("Hits for [$terms]: $recs->{count}");
1458 my $feed = create_record_feed(
1461 [ map { $_->[0] } @{$recs->{ids}} ],
1468 $log->debug("Feed created...");
1472 $feed->search($safe_terms);
1473 $feed->class($class);
1475 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1477 $feed->creator($host);
1480 $feed->_create_node(
1481 $feed->{item_xpath},
1482 'http://a9.com/-/spec/opensearch/1.1/',
1487 $feed->_create_node(
1488 $feed->{item_xpath},
1489 'http://a9.com/-/spec/opensearch/1.1/',
1494 $feed->_create_node(
1495 $feed->{item_xpath},
1496 'http://a9.com/-/spec/opensearch/1.1/',
1501 $log->debug("...basic feed data added...");
1505 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1506 'application/opensearch+xml'
1507 ) if ($offset + $limit < $recs->{count});
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'
1517 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1518 'application/opensearch+xml'
1523 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1524 'application/rss+xml'
1529 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1530 'application/atom+xml'
1535 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1541 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1545 $feed->link( 'unapi-server' => $unapi);
1547 $log->debug("...feed links added...");
1551 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1552 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1556 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1558 -type => $feed->type, -charset => 'UTF-8',
1559 extra_headers_per_type_to_cgi($type)
1560 ), $feed->toString, "\n";
1562 $log->debug("...and feed returned.");
1564 return Apache2::Const::OK;
1567 sub create_record_feed {
1570 my $records = shift;
1573 my $lib = uc(shift()) || '-';
1580 my $base = $cgi->url;
1581 my $host = $cgi->virtual_host || $cgi->server_name;
1583 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1587 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1589 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1591 $type =~ s/(-full|-uris)$//o;
1593 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1594 $feed->base($base) if ($flesh);
1595 $feed->unapi($unapi) if ($flesh);
1597 $type = 'atom' if ($type eq 'html');
1598 $type = 'marcxml' if
1599 $type eq 'htmlholdings' or
1600 $type eq 'marctxt' or
1602 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1604 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1607 for my $record (@$records) {
1608 next unless($record);
1610 #my $rec = $record->id;
1613 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1614 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1615 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1616 $item_tag .= "/$depth" if (defined($depth));
1618 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1620 my $xml = $supercat->request(
1621 "open-ils.supercat.$search.$type.retrieve",
1626 my $node = $feed->add_item($xml);
1630 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1631 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1632 while ( !$r->complete ) {
1633 $xml .= join('', map {$_->content} $r->recv);
1635 $xml .= join('', map {$_->content} $r->recv);
1636 $node->add_holdings($xml);
1639 $node->id($item_tag);
1640 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1641 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1642 $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1643 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1644 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1645 $node->link('unapi-id' => $item_tag) if ($flesh);
1653 return Apache2::Const::DECLINED if (-e $apache->filename);
1658 my $year = (gmtime())[5] + 1900;
1660 my $host = $cgi->virtual_host || $cgi->server_name;
1663 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1664 my $rel_name = $cgi->url(-relative=>1);
1665 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1668 my $url = $cgi->url(-path_info=>$add_path);
1669 my $root = (split 'browse', $url)[0];
1670 my $base = (split 'browse', $url)[0] . 'browse';
1671 my $unapi = (split 'browse', $url)[0] . 'unapi';
1673 my $path = $cgi->path_info;
1676 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1677 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1679 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1681 my $status = [$cgi->param('status')];
1682 my $cpLoc = [$cgi->param('copyLocation')];
1683 $site ||= $cgi->param('searchOrg');
1684 $page ||= $cgi->param('startPage') || 0;
1685 $page_size ||= $cgi->param('count') || 9;
1686 $thesauruses //= '';
1687 $thesauruses =~ s/\s//g;
1688 # protect against cats bouncing on the comma key...
1689 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1691 $page = 0 if ($page !~ /^-?\d+$/);
1692 $page_size = 9 if $page_size !~ /^\d+$/;
1694 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1695 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1697 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1698 warn "something's wrong...";
1699 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1703 $string = decode_utf8($string);
1704 $string =~ s/\+/ /go;
1708 if ($axis =~ /^authority/) {
1709 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1711 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1712 $method .= ".refs" if $refs;
1714 $tree = $supercat->request(
1723 $tree = $supercat->request(
1724 "open-ils.supercat.$axis.browse",
1734 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1736 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1737 print $header.$content;
1738 return Apache2::Const::OK;
1741 sub string_startwith {
1743 return Apache2::Const::DECLINED if (-e $apache->filename);
1748 my $year = (gmtime())[5] + 1900;
1750 my $host = $cgi->virtual_host || $cgi->server_name;
1753 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1754 my $rel_name = $cgi->url(-relative=>1);
1755 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1758 my $url = $cgi->url(-path_info=>$add_path);
1759 my $root = (split 'startwith', $url)[0];
1760 my $base = (split 'startwith', $url)[0] . 'startwith';
1761 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1763 my $path = $cgi->path_info;
1766 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1767 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1769 my $status = [$cgi->param('status')];
1770 my $cpLoc = [$cgi->param('copyLocation')];
1771 $site ||= $cgi->param('searchOrg');
1772 $page ||= $cgi->param('startPage') || 0;
1773 $page_size ||= $cgi->param('count') || 9;
1774 $thesauruses //= '';
1775 $thesauruses =~ s/\s//g;
1776 # protect against cats bouncing on the comma key...
1777 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1779 $page = 0 if ($page !~ /^-?\d+$/);
1780 $page_size = 9 if $page_size !~ /^\d+$/;
1782 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1783 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1785 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1786 warn "something's wrong...";
1787 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1791 $string = decode_utf8($string);
1792 $string =~ s/\+/ /go;
1796 if ($axis =~ /^authority/) {
1797 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1799 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1800 $method .= ".refs" if $refs;
1802 $tree = $supercat->request(
1811 $tree = $supercat->request(
1812 "open-ils.supercat.$axis.startwith",
1822 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1824 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1825 print $header.$content;
1826 return Apache2::Const::OK;
1829 sub item_age_browse {
1831 return Apache2::Const::DECLINED if (-e $apache->filename);
1836 my $year = (gmtime())[5] + 1900;
1838 my $host = $cgi->virtual_host || $cgi->server_name;
1841 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1842 my $rel_name = $cgi->url(-relative=>1);
1843 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1846 my $url = $cgi->url(-path_info=>$add_path);
1847 my $root = (split 'browse', $url)[0];
1848 my $base = (split 'browse', $url)[0] . 'browse';
1849 my $unapi = (split 'browse', $url)[0] . 'unapi';
1851 my $path = $cgi->path_info;
1854 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1855 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1857 unless ($axis eq 'item-age') {
1858 warn "something's wrong...";
1859 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1863 my $status = [$cgi->param('status')];
1864 my $cpLoc = [$cgi->param('copyLocation')];
1865 $site ||= $cgi->param('searchOrg') || '-';
1866 $page ||= $cgi->param('startPage') || 1;
1867 $page_size ||= $cgi->param('count') || 10;
1869 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1870 $page_size = 10 if $page_size !~ /^\d+$/;
1872 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1873 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1875 my $recs = $supercat->request(
1876 "open-ils.supercat.new_book_list",
1884 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1886 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1887 print $header.$content;
1888 return Apache2::Const::OK;
1891 our %qualifier_ids = (
1892 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1893 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1894 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1898 # Our authority search options are currently pretty impoverished;
1899 # just right-truncated string match on a few categories, or by
1901 our %nested_auth_qualifier_map = (
1903 id => { index => 'id', title => 'Record number'},
1904 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1905 title => { index => 'title', title => 'Uniform title'},
1906 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1907 topic => { index => 'topic', title => 'Topical term'},
1911 my $base_explain = <<XML;
1913 id="evergreen-sru-explain-full"
1914 authoritative="true"
1915 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1916 xmlns="http://explain.z3950.org/dtd/2.0/">
1917 <serverInfo transport="http" protocol="SRU" version="1.1">
1924 <title primary="true"/>
1925 <description primary="true"/>
1929 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1934 identifier="info:srw/schema/1/marcxml-v1.1"
1935 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1939 <title>MARC21Slim (marcxml)</title>
1944 <default type="numberOfRecords">10</default>
1945 <default type="contextSet">eg</default>
1946 <default type="index">keyword</default>
1947 <default type="relation">all</default>
1948 <default type="sortSchema">marcxml</default>
1949 <default type="retrieveSchema">marcxml</default>
1950 <setting type="maximumRecords">50</setting>
1951 <supports type="relationModifier">relevant</supports>
1952 <supports type="relationModifier">stem</supports>
1953 <supports type="relationModifier">fuzzy</supports>
1954 <supports type="relationModifier">word</supports>
1967 my $req = SRU::Request->newFromCGI( $cgi );
1968 my $resp = SRU::Response->newFromRequest( $req );
1970 # Find the org_unit shortname, if passed as part of the URL
1971 # http://example.com/opac/extras/sru/SHORTNAME
1972 my $url = $cgi->path_info;
1973 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1975 if ( $resp->type eq 'searchRetrieve' ) {
1977 # Older versions of Debian packages returned terms to us double-encoded,
1978 # so we had to forcefully double-decode them a second time with
1979 # an outer decode('utf8', $string) call; this seems to be resolved with
1980 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1981 my $cql_query = decode_utf8($req->query);
1982 my $search_string = decode_utf8($req->cql->toEvergreen);
1984 # Ensure the search string overrides the default site
1985 if ($shortname and $search_string !~ m#site:#) {
1986 $search_string .= " site:$shortname";
1989 my $offset = $req->startRecord;
1990 $offset-- if ($offset);
1993 my $limit = $req->maximumRecords;
1996 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1998 if (!$shortname || $shortname eq '-') {
1999 my $search_org = get_ou($shortname);
2000 $shortname = $search_org->[0]->shortname;
2003 my $recs = $search->request(
2004 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
2007 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2008 foreach my $rec (@{$recs->{ids}}) {
2009 my $rec_id = shift @$rec;
2010 my $data = $cstore->request(
2011 'open-ils.cstore.json_query' => {
2013 'unapi.bre', $rec_id,
2014 'marcxml', 'record',
2015 ($holdings) ? '{holdings_xml,acp}' : '{}',
2021 my $marcxml = XML::LibXML->load_xml( string => $data->{'unapi.bre'} );
2023 # process <holdings> element, if any
2025 for my $node ($marcxml->getElementsByTagName('holdings')) {
2026 for my $volume ($node->getElementsByTagName('volume')) {
2027 my $cn = $volume->getAttribute('label');
2028 my $owning_lib = $volume->getAttribute('lib');
2029 for my $copy ($volume->getElementsByTagName('copy')) {
2031 a => $copy->getChildrenByTagName('location')->[0]->textContent,
2034 d => $copy->getChildrenByTagName('circlib')->[0]->textContent,
2035 g => $copy->getAttribute('barcode'),
2036 n => $copy->getChildrenByTagName('status')->[0]->textContent
2040 # remove <holdings> element
2041 $node->parentNode->removeChild($node);
2044 my $marc = MARC::Record->new_from_xml($marcxml->toString(), 'UTF8', 'XML');
2046 # Force record leader to 'a' as our data is always UTF8
2047 # Avoids marc8_to_utf8 from being invoked with horrible results
2048 # on the off-chance the record leader isn't correct
2049 my $ldr = $marc->leader;
2050 substr($ldr, 9, 1, 'a');
2051 $marc->leader($ldr);
2053 # Expects the record ID in the 001
2054 $marc->delete_field($_) for ($marc->field('001'));
2055 if (!$marc->field('001')) {
2056 $marc->insert_fields_ordered(
2057 MARC::Field->new( '001', $rec_id )
2061 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
2062 for my $copy (@copies) {
2063 $marc->insert_fields_ordered(
2076 my $output = $marc->as_xml_record();
2077 $output =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2079 SRU::Response::Record->new(
2080 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2081 recordData => $output,
2082 recordPosition => ++$offset
2086 } catch Error with {
2087 $log->error("Failed to process record for SRU search");
2091 $resp->numberOfRecords($recs->{count});
2093 } elsif ( $resp->type eq 'explain' ) {
2094 return_sru_explain($cgi, $req, $resp, \$ex_doc,
2096 \%OpenILS::WWW::SuperCat::qualifier_ids
2100 SRU::Response::Record->new(
2101 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2102 recordData => $ex_doc
2107 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2108 print $U->entityize($resp->asXML) . "\n";
2109 return Apache2::Const::OK;
2114 package CQL::BooleanNode;
2118 my $left = $self->left();
2119 my $right = $self->right();
2120 my $leftStr = $left->toEvergreen;
2121 my $rightStr = $right->toEvergreen();
2123 my $op = '||' if uc $self->op() eq 'OR';
2126 return "$leftStr $rightStr";
2129 sub toEvergreenAuth {
2130 return toEvergreen(shift);
2133 package CQL::TermNode;
2137 my $qualifier = $self->getQualifier();
2138 my $term = $self->getTerm();
2139 my $relation = $self->getRelation();
2143 my ($qset, $qname) = split(/\./, $qualifier);
2145 # Per http://www.loc.gov/standards/sru/specs/cql.html
2146 # "All parts of CQL are case insensitive [...] If any case insensitive
2147 # part of CQL is specified with both upper and lower case, it is for
2148 # aesthetic purposes only."
2150 # So fold the qualifier and relation to lower case
2152 $qname = lc($qname);
2154 if ( exists($qualifier_map{$qset}{$qname}) ) {
2155 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2156 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2159 my @modifiers = $relation->getModifiers();
2161 my $base = $relation->getBase();
2162 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2165 foreach my $m ( @modifiers ) {
2166 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2172 $quote_it = 0 if ( $base eq 'all' );
2173 $term = maybeQuote($term) if $quote_it;
2176 croak( "Evergreen doesn't support the $base relations" );
2184 return "$qualifier:$term";
2187 sub toEvergreenAuth {
2189 my $qualifier = $self->getQualifier();
2190 my $term = $self->getTerm();
2191 my $relation = $self->getRelation();
2195 my ($qset, $qname) = split(/\./, $qualifier);
2197 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2198 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2199 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2202 return { qualifier => $qualifier, term => $term };
2207 sub sru_auth_search {
2212 my $req = SRU::Request->newFromCGI( $cgi );
2213 my $resp = SRU::Response->newFromRequest( $req );
2215 if ( $resp->type eq 'searchRetrieve' ) {
2216 return_auth_response($cgi, $req, $resp);
2217 } elsif ( $resp->type eq 'explain' ) {
2218 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2219 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2220 \%OpenILS::WWW::SuperCat::qualifier_ids
2224 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2225 print $U->entityize($resp->asXML) . "\n";
2226 return Apache2::Const::OK;
2229 sub explain_header {
2232 my $host = $cgi->virtual_host || $cgi->server_name;
2235 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2236 my $rel_name = $cgi->url(-relative=>1);
2237 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2239 my $base = $cgi->url(-base=>1);
2240 my $url = $cgi->url(-path_info=>$add_path);
2241 $url =~ s/^$base\///o;
2243 my $doc = $parser->parse_string($base_explain);
2244 my $e = $doc->documentElement;
2245 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2246 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2247 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2252 sub return_sru_explain {
2253 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2255 $index_map ||= \%qualifier_map;
2257 my ($doc, $e) = explain_header($cgi);
2258 for my $name ( keys %{$index_map} ) {
2260 my $identifier = $qualifier_ids->{ $name };
2262 next unless $identifier;
2264 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2265 $set_node->setAttribute( identifier => $identifier );
2266 $set_node->setAttribute( name => $name );
2268 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2269 for my $index ( sort keys %{$index_map->{$name}} ) {
2270 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2272 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2273 $map_node->appendChild( $name_node );
2275 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2277 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2278 $index_node->appendChild( $title_node );
2279 $index_node->appendChild( $map_node );
2281 $index_node->setAttribute( id => "$name.$index" );
2282 $title_node->appendText($index_map->{$name}{$index}{'title'});
2283 $name_node->setAttribute( set => $name );
2284 $name_node->appendText($index_map->{$name}{$index}{'index'});
2286 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2290 $$explain = $e->toString;
2294 SRU::Response::Record->new(
2295 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2296 recordData => $$explain
2302 sub return_auth_response {
2303 my ($cgi, $req, $resp) = @_;
2305 my $cql_query = decode_utf8($req->query);
2306 my $search = $req->cql->toEvergreenAuth;
2308 my $qualifier = decode_utf8($search->{qualifier});
2309 my $term = decode_utf8($search->{term});
2311 $log->info("SRU NAF search string [$cql_query] converted to "
2312 . "[$qualifier:$term]\n");
2314 my $page_size = $req->maximumRecords;
2317 # startwith deals with pages, so convert startRecord to a page number
2318 my $page = ($req->startRecord / $page_size) || 0;
2321 if ($qualifier eq "id") {
2322 $recs = [ int($term) ];
2324 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2326 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2327 $method .= ".refs" if $refs;
2329 $recs = $supercat->request(
2338 my $record_position = $req->startRecord;
2339 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2340 foreach my $record (@$recs) {
2341 my $marcxml = $cstore->request(
2342 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2346 SRU::Response::Record->new(
2347 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2348 recordData => $marcxml,
2349 recordPosition => ++$record_position
2354 $resp->numberOfRecords(scalar(@$recs));
2357 =head2 get_ou($org_unit)
2359 Returns an aou object for a given actor.org_unit shortname or ID.
2364 my $org = shift || '-';
2368 $org_unit = $actor->request(
2369 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2371 } elsif ($org !~ /^\d+$/o) {
2372 $org_unit = $actor->request(
2373 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2376 $org_unit = $actor->request(
2377 'open-ils.actor.org_unit_list.search' => id => $org