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 ->request("open-ils.supercat.u2", $u2->toURI, $format)
465 return Apache2::Const::OK;
471 return Apache2::Const::DECLINED if (-e $apache->filename);
478 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
479 my $rel_name = $cgi->url(-relative=>1);
480 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
483 my $url = $cgi->url(-path_info=>$add_path);
484 my $root = (split 'unapi', $url)[0];
485 my $base = (split 'unapi', $url)[0] . 'unapi';
488 my $uri = $cgi->param('id') || '';
490 my $format = $cgi->param('format') || '';
491 (my $base_format = $format) =~ s/(-full|-uris)$//o;
492 my $u2uri = OpenILS::Utils::TagURI->new($uri);
493 if ($format and $u2uri->version > 1) {
494 return unapi2($apache, $u2uri, $format);
497 my $host = $cgi->virtual_host || $cgi->server_name;
499 my $skin = $cgi->param('skin') || 'default';
500 my $locale = $cgi->param('locale') || 'en-US';
502 # Enable localized results of copy status, etc
503 $supercat->session_locale($locale);
505 my $flesh_feed = parse_feed_type($format);
506 (my $base_format = $format) =~ s/(-full|-uris)$//o;
507 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
508 my $body = "Content-type: application/xml; charset=utf-8\n\n";
510 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
513 ($lib,$depth) = split('/', $4);
514 $type = 'metarecord' if ($1 =~ /^m/o);
515 $type = 'authority' if ($1 =~ /^authority/o);
519 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
522 ->request("open-ils.supercat.$type.formats")
525 if ($type eq 'record' or $type eq 'isbn') {
526 $body .= <<" FORMATS";
528 <format name='opac' type='text/html'/>
529 <format name='html' type='text/html'/>
530 <format name='htmlholdings' type='text/html'/>
531 <format name='holdings_xml' type='application/xml'/>
532 <format name='holdings_xml-full' type='application/xml'/>
533 <format name='html-full' type='text/html'/>
534 <format name='htmlholdings-full' type='text/html'/>
535 <format name='marctxt' type='text/plain'/>
536 <format name='ris' type='text/plain'/>
538 } elsif ($type eq 'metarecord') {
539 $body .= <<" FORMATS";
541 <format name='opac' type='text/html'/>
544 $body .= <<" FORMATS";
550 my ($type) = keys %$h;
551 $body .= unapi_format($h, $type);
553 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
554 $body .= unapi_format($h, "$type-full");
555 $body .= unapi_format($h, "$type-uris");
559 $body .= "</formats>\n";
563 ->request("open-ils.supercat.$type.formats")
568 ->request("open-ils.supercat.metarecord.formats")
572 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
573 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
575 $body .= <<" FORMATS";
577 <format name='opac' type='text/html'/>
578 <format name='html' type='text/html'/>
579 <format name='htmlholdings' type='text/html'/>
580 <format name='holdings_xml' type='application/xml'/>
581 <format name='holdings_xml-full' type='application/xml'/>
582 <format name='html-full' type='text/html'/>
583 <format name='htmlholdings-full' type='text/html'/>
584 <format name='marctxt' type='text/plain'/>
585 <format name='ris' type='text/plain'/>
590 my ($type) = keys %$h;
591 $body .= "\t" . unapi_format($h, $type);
593 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
594 $body .= "\t" . unapi_format($h, "$type-full");
595 $body .= "\t" . unapi_format($h, "$type-uris");
599 $body .= "</formats>\n";
603 return Apache2::Const::OK;
607 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
611 ($lib,$depth) = split('/', $4);
613 $type = 'metarecord' if ($scheme =~ /^metabib/o);
614 $type = 'isbn' if ($scheme =~ /^isbn/o);
615 $type = 'acp' if ($scheme =~ /^asset-copy/o);
616 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
617 $type = 'auri' if ($scheme =~ /^asset-uri/o);
618 $type = 'authority' if ($scheme =~ /^authority/o);
619 $command = 'retrieve';
620 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
621 $command = 'browse' if ($scheme =~ /^authority/);
625 $paging = [split ',', $paging];
630 if (!$lib || $lib eq '-') {
631 $lib = $actor->request(
632 'open-ils.actor.org_unit_list.search' => parent_ou => undef
633 )->gather(1)->[0]->shortname;
636 my ($lib_object,$lib_id,$ou_types,$lib_depth);
637 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
638 $lib_object = $actor->request(
639 'open-ils.actor.org_unit_list.search' => shortname => $lib
641 $lib_id = $lib_object->id;
643 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
644 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
647 if ($command eq 'browse') {
648 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
652 if ($type eq 'isbn') {
653 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
655 # Escape user input before display
656 $command = CGI::escapeHTML($command);
657 $id = CGI::escapeHTML($id);
658 $type = CGI::escapeHTML($type);
659 $format = CGI::escapeHTML(decode_utf8($format));
661 print "Content-type: text/html; charset=utf-8\n\n";
662 $apache->custom_response( 404, <<" HTML");
665 <title>Type [$type] with id [$id] not found!</title>
669 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
680 { (keys(%$_))[0] eq $base_format }
681 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
683 { $_ eq $base_format }
684 qw/opac html htmlholdings marctxt ris holdings_xml/
686 # Escape user input before display
687 $format = CGI::escapeHTML($format);
688 $type = CGI::escapeHTML($type);
690 print "Content-type: text/html; charset=utf-8\n\n";
691 $apache->custom_response( 406, <<" HTML");
694 <title>Invalid format [$format] for type [$type]!</title>
698 <center>Sorry, format $format is not valid for type $type.</center>
705 if ($format eq 'opac') {
706 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
707 if ($type eq 'metarecord');
708 print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
709 if ($type eq 'record');
711 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
712 my $feed = create_record_feed(
723 # Escape user input before display
724 $command = CGI::escapeHTML($command);
725 $id = CGI::escapeHTML($id);
726 $type = CGI::escapeHTML($type);
727 $format = CGI::escapeHTML(decode_utf8($format));
729 print "Content-type: text/html; charset=utf-8\n\n";
730 $apache->custom_response( 404, <<" HTML");
733 <title>Type [$type] with id [$id] not found!</title>
737 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
745 $feed->creator($host);
747 $feed->link( unapi => $base) if ($flesh_feed);
749 print "Content-type: ". $feed->type ."; charset=utf-8\n";
751 print $_ for extra_headers_per_type_to_string($type);
753 print "\n", $feed->toString, "\n";
755 return Apache2::Const::OK;
758 my $method = "open-ils.supercat.$type.$base_format.$command";
760 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
762 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
763 # however, we can have it carry extra options like no_record! (comma separated)
764 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
766 my $req = $supercat->request($method,@params);
767 my $data = $req->gather();
769 if ($req->failed || !$data) {
770 # Escape user input before display
771 $command = CGI::escapeHTML($command);
772 $id = CGI::escapeHTML($id);
773 $type = CGI::escapeHTML($type);
774 $format = CGI::escapeHTML(decode_utf8($format));
776 print "Content-type: text/html; charset=utf-8\n\n";
777 $apache->custom_response( 404, <<" HTML");
780 <title>$type $id not found!</title>
784 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
791 print "Content-type: application/xml; charset=utf-8\n\n";
793 # holdings_xml format comes back to us without an XML declaration
794 # and without being entityized; fix that here
795 if ($base_format eq 'holdings_xml') {
796 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
797 print $U->entityize($data);
799 while (my $c = $req->recv) {
800 print $U->entityize($c->content);
806 return Apache2::Const::OK;
812 return Apache2::Const::DECLINED if (-e $apache->filename);
819 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
820 my $rel_name = $cgi->url(-relative=>1);
821 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
824 my $url = $cgi->url(-path_info=>$add_path);
825 my $root = (split 'supercat', $url)[0];
826 my $base = (split 'supercat', $url)[0] . 'supercat';
827 my $unapi = (split 'supercat', $url)[0] . 'unapi';
829 my $host = $cgi->virtual_host || $cgi->server_name;
831 my $path = $cgi->path_info;
832 my ($id,$type,$format,$command) = reverse split '/', $path;
833 my $flesh_feed = parse_feed_type($format);
834 (my $base_format = $format) =~ s/(-full|-uris)$//o;
836 my $skin = $cgi->param('skin') || 'default';
837 my $locale = $cgi->param('locale') || 'en-US';
839 # Enable localized results of copy status, etc
840 $supercat->session_locale($locale);
842 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
843 print "Content-type: application/xml; charset=utf-8\n";
846 ->request("open-ils.supercat.$1.formats")
854 <type>text/html</type>
857 if ($1 eq 'record' or $1 eq 'isbn') {
859 <name>htmlholdings</name>
860 <type>text/html</type>
864 <type>text/html</type>
867 <name>htmlholdings-full</name>
868 <type>text/html</type>
871 <name>html-full</name>
872 <type>text/html</type>
876 <type>text/plain</type>
880 <type>text/plain</type>
885 my ($type) = keys %$h;
886 print supercat_format($h, $type);
888 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
889 print supercat_format($h, "$type-full");
890 print supercat_format($h, "$type-uris");
895 print "</formats>\n";
897 return Apache2::Const::OK;
901 ->request("open-ils.supercat.record.formats")
906 ->request("open-ils.supercat.metarecord.formats")
910 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
911 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
916 <type>text/html</type>
919 <name>htmlholdings</name>
920 <type>text/html</type>
924 <type>text/html</type>
927 <name>htmlholdings-full</name>
928 <type>text/html</type>
931 <name>html-full</name>
932 <type>text/html</type>
936 <type>text/plain</type>
940 <type>text/plain</type>
944 my ($type) = keys %$h;
945 print supercat_format($h, $type);
947 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
948 print supercat_format($h, "$type-full");
949 print supercat_format($h, "$type-uris");
954 print "</formats>\n";
957 return Apache2::Const::OK;
960 if ($format eq 'opac') {
961 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
962 if ($type eq 'metarecord');
963 print "Location: /eg/opac/record/$id\n\n"
964 if ($type eq 'record');
967 } elsif ($base_format eq 'marc21') {
971 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
973 print "Content-type: application/octet-stream\n";
974 print $_ for extra_headers_per_type_to_string($base_format);
975 print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
980 # Escape user input before display
981 $id = CGI::escapeHTML($id);
983 print "Content-type: text/html; charset=utf-8\n\n";
984 $apache->custom_response( 404, <<" HTML");
991 <center>Couldn't fetch $id as MARC21.</center>
998 return Apache2::Const::OK;
1000 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
1001 my $feed = create_record_feed(
1004 undef, undef, undef,
1009 $feed->creator($host);
1013 $feed->link( unapi => $base) if ($flesh_feed);
1015 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1017 print $_ for extra_headers_per_type_to_string($type);
1019 print "\n", $feed->toString, "\n";
1021 return Apache2::Const::OK;
1024 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
1025 $req->wait_complete;
1028 # Escape user input before display
1029 $command = CGI::escapeHTML($command);
1030 $id = CGI::escapeHTML($id);
1031 $type = CGI::escapeHTML($type);
1032 $format = CGI::escapeHTML(decode_utf8($format));
1034 print "Content-type: text/html; charset=utf-8\n\n";
1035 $apache->custom_response( 404, <<" HTML");
1038 <title>$type $id not found!</title>
1042 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
1049 print "Content-type: application/xml; charset=utf-8\n\n";
1050 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
1052 return Apache2::Const::OK;
1058 return Apache2::Const::DECLINED if (-e $apache->filename);
1064 my $year = (gmtime())[5] + 1900;
1065 my $host = $cgi->virtual_host || $cgi->server_name;
1068 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1069 my $rel_name = $cgi->url(-relative=>1);
1070 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1073 my $url = $cgi->url(-path_info=>$add_path);
1074 my $root = (split 'feed', $url)[0] . '/';
1075 my $base = (split 'bookbag', $url)[0] . '/bookbag';
1076 my $unapi = (split 'feed', $url)[0] . '/unapi';
1078 my $skin = $cgi->param('skin') || 'default';
1079 my $locale = $cgi->param('locale') || 'en-US';
1080 my $org = $cgi->param('searchOrg');
1082 # Enable localized results of copy status, etc
1083 $supercat->session_locale($locale);
1085 my $org_unit = get_ou($org);
1086 my $scope = "l=" . $org_unit->[0]->id . "&";
1088 $root =~ s{(?<!http:)//}{//}go;
1089 $base =~ s{(?<!http:)//}{//}go;
1090 $unapi =~ s{(?<!http:)//}{//}go;
1092 my $path = $cgi->path_info;
1093 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1095 my ($id,$type) = reverse split '/', $path;
1096 my $flesh_feed = parse_feed_type($type);
1098 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1099 return Apache2::Const::NOT_FOUND unless($bucket);
1101 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1102 if (lc($type) eq 'opac') {
1103 print "Location: /eg/opac/results?bookbag=$id\n\n";
1107 # last created first
1108 my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1110 my $feed = create_record_feed(
1113 [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1115 $org_unit->[0]->shortname,
1120 $feed->id($bucket_tag);
1122 $feed->title($bucket->name);
1123 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1124 $feed->creator($host);
1127 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1128 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1129 $feed->link(opac => $base . "/opac/$id" => 'text/html');
1130 $feed->link(OPAC => $base . "/opac/$id" => 'text/html');
1131 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1132 $feed->link(unapi => $unapi);
1134 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1135 print $feed->toString . "\n";
1137 return Apache2::Const::OK;
1142 return Apache2::Const::DECLINED if (-e $apache->filename);
1148 my $year = (gmtime())[5] + 1900;
1149 my $host = $cgi->virtual_host || $cgi->server_name;
1152 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1153 my $rel_name = $cgi->url(-relative=>1);
1154 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1157 my $url = $cgi->url(-path_info=>$add_path);
1158 my $root = (split 'feed', $url)[0];
1159 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1160 my $unapi = (split 'feed', $url)[0] . 'unapi';
1162 my $skin = $cgi->param('skin') || 'default';
1163 my $locale = $cgi->param('locale') || 'en-US';
1164 my $org = $cgi->param('searchOrg');
1166 # Enable localized results of copy status, etc
1167 $supercat->session_locale($locale);
1169 my $org_unit = get_ou($org);
1170 my $scope = "l=" . $org_unit->[0]->id . "&";
1172 my $path = $cgi->path_info;
1173 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1175 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1177 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1178 my $flesh_feed = parse_feed_type($type);
1181 $limit = 10 if $limit !~ /^\d+$/;
1183 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1185 if (lc($type) eq 'opac') {
1186 print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
1190 my $search = 'record';
1191 if ($rtype eq 'authority') {
1192 $search = 'authority';
1194 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1198 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1200 $feed->title("$limit most recent $rtype ${axis}s");
1203 $feed->creator($host);
1206 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1207 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1208 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1209 $feed->link(unapi => $unapi);
1213 "http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
1218 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1220 print $_ for extra_headers_per_type_to_string($type);
1222 print "\n", $feed->toString, "\n";
1224 return Apache2::Const::OK;
1227 sub opensearch_osd {
1228 my $version = shift;
1234 if ($version eq '1.0') {
1236 Content-type: application/opensearchdescription+xml; charset=utf-8
1238 <?xml version="1.0" encoding="UTF-8"?>
1239 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1240 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1241 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1242 <ShortName>$lib</ShortName>
1243 <LongName>Search $lib</LongName>
1244 <Description>Search the $lib OPAC by $class.</Description>
1245 <Tags>$lib book library</Tags>
1246 <SampleSearch>harry+potter</SampleSearch>
1247 <Developer>Mike Rylander for GPLS/PINES</Developer>
1248 <Contact>feedback\@open-ils.org</Contact>
1249 <SyndicationRight>open</SyndicationRight>
1250 <AdultContent>false</AdultContent>
1251 </OpenSearchDescription>
1255 Content-type: application/opensearchdescription+xml; charset=utf-8
1257 <?xml version="1.0" encoding="UTF-8"?>
1258 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1259 <ShortName>$lib</ShortName>
1260 <Description>Search the $lib OPAC by $class.</Description>
1261 <Tags>$lib book library</Tags>
1262 <Url type="application/rss+xml"
1263 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1264 <Url type="application/atom+xml"
1265 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1266 <Url type="application/x-mods3+xml"
1267 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1268 <Url type="application/x-mods+xml"
1269 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1270 <Url type="application/octet-stream"
1271 template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1272 <Url type="application/x-marcxml+xml"
1273 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1274 <Url type="text/html"
1275 template="https://$host/eg/opac/results?locg=$lib;query={searchTerms};page={startPage?};startIndex={startIndex?};count={count?};searchLang={language?}"/>
1276 <LongName>Search $lib</LongName>
1277 <Query role="example" searchTerms="harry+potter" />
1278 <Developer>Mike Rylander for GPLS/PINES</Developer>
1279 <Contact>feedback\@open-ils.org</Contact>
1280 <SyndicationRight>open</SyndicationRight>
1281 <AdultContent>false</AdultContent>
1282 <Language>en-US</Language>
1283 <OutputEncoding>UTF-8</OutputEncoding>
1284 <InputEncoding>UTF-8</InputEncoding>
1285 </OpenSearchDescription>
1289 return Apache2::Const::OK;
1292 sub opensearch_feed {
1294 return Apache2::Const::DECLINED if (-e $apache->filename);
1299 my $year = (gmtime())[5] + 1900;
1301 my $host = $cgi->virtual_host || $cgi->server_name;
1304 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1305 my $rel_name = $cgi->url(-relative=>1);
1306 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1309 my $url = $cgi->url(-path_info=>$add_path);
1310 my $root = (split 'opensearch', $url)[0];
1311 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1312 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1314 my $path = $cgi->path_info;
1315 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1317 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1323 if (!$lib || $lib eq '-') {
1324 $lib = $actor->request(
1325 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1326 )->gather(1)->[0]->shortname;
1329 if ($class eq '-') {
1333 return opensearch_osd($version, $lib, $class, $base, $host);
1337 my $page = $cgi->param('startPage') || 1;
1338 my $offset = $cgi->param('startIndex') || 1;
1339 my $limit = $cgi->param('count') || 10;
1341 $page = 1 if ($page !~ /^\d+$/);
1342 $offset = 1 if ($offset !~ /^\d+$/);
1343 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1346 $offset = ($page - 1) * $limit;
1351 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1352 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1354 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1355 $lang = '' if ($lang eq '*');
1357 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1359 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1362 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1363 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1365 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1368 $type = $cgi->param('responseType') if $cgi->param('responseType');
1371 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1375 my $kwt = $cgi->param('kw');
1376 my $tit = $cgi->param('ti');
1377 my $aut = $cgi->param('au');
1378 my $sut = $cgi->param('su');
1379 my $set = $cgi->param('se');
1381 $terms .= " " if ($terms && $kwt);
1382 $terms .= "keyword: $kwt" if ($kwt);
1383 $terms .= " " if ($terms && $tit);
1384 $terms .= "title: $tit" if ($tit);
1385 $terms .= " " if ($terms && $aut);
1386 $terms .= "author: $aut" if ($aut);
1387 $terms .= " " if ($terms && $sut);
1388 $terms .= "subject: $sut" if ($sut);
1389 $terms .= " " if ($terms && $set);
1390 $terms .= "series: $set" if ($set);
1392 if ($version eq '1.0') {
1394 } elsif ($type eq '-') {
1397 my $flesh_feed = parse_feed_type($type);
1399 $terms = decode_utf8($terms);
1400 $lang = 'eng' if ($lang eq 'en-US');
1402 $log->debug("OpenSearch terms: $terms");
1404 my $org_unit = get_ou($org);
1406 # Apostrophes break search and get indexed as spaces anyway
1407 my $safe_terms = $terms;
1408 $safe_terms =~ s{'}{ }go;
1410 my $recs = $search->request(
1411 'open-ils.search.biblio.multiclass.query' => {
1412 org_unit => $org_unit->[0]->id,
1416 sort_dir => $sortdir,
1417 default_class => $class,
1418 ($lang ? ( 'language' => $lang ) : ()),
1419 } => $safe_terms => 1
1422 $log->debug("Hits for [$terms]: $recs->{count}");
1424 my $feed = create_record_feed(
1427 [ map { $_->[0] } @{$recs->{ids}} ],
1434 $log->debug("Feed created...");
1438 $feed->search($safe_terms);
1439 $feed->class($class);
1441 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1443 $feed->creator($host);
1446 $feed->_create_node(
1447 $feed->{item_xpath},
1448 'http://a9.com/-/spec/opensearch/1.1/',
1453 $feed->_create_node(
1454 $feed->{item_xpath},
1455 'http://a9.com/-/spec/opensearch/1.1/',
1460 $feed->_create_node(
1461 $feed->{item_xpath},
1462 'http://a9.com/-/spec/opensearch/1.1/',
1467 $log->debug("...basic feed data added...");
1471 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1472 'application/opensearch+xml'
1473 ) if ($offset + $limit < $recs->{count});
1477 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1478 'application/opensearch+xml'
1483 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1484 'application/opensearch+xml'
1489 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1490 'application/rss+xml'
1495 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1496 'application/atom+xml'
1501 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1507 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1511 $feed->link( 'unapi-server' => $unapi);
1513 $log->debug("...feed links added...");
1517 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1518 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1522 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1524 -type => $feed->type, -charset => 'UTF-8',
1525 extra_headers_per_type_to_cgi($type)
1526 ), $feed->toString, "\n";
1528 $log->debug("...and feed returned.");
1530 return Apache2::Const::OK;
1533 sub create_record_feed {
1536 my $records = shift;
1539 my $lib = uc(shift()) || '-';
1546 my $base = $cgi->url;
1547 my $host = $cgi->virtual_host || $cgi->server_name;
1549 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1553 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1555 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1557 $type =~ s/(-full|-uris)$//o;
1559 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1560 $feed->base($base) if ($flesh);
1561 $feed->unapi($unapi) if ($flesh);
1563 $type = 'atom' if ($type eq 'html');
1564 $type = 'marcxml' if
1565 $type eq 'htmlholdings' or
1566 $type eq 'marctxt' or
1568 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1570 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1573 for my $record (@$records) {
1574 next unless($record);
1576 #my $rec = $record->id;
1579 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1580 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1581 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1582 $item_tag .= "/$depth" if (defined($depth));
1584 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1586 my $xml = $supercat->request(
1587 "open-ils.supercat.$search.$type.retrieve",
1592 my $node = $feed->add_item($xml);
1596 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1597 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1598 while ( !$r->complete ) {
1599 $xml .= join('', map {$_->content} $r->recv);
1601 $xml .= join('', map {$_->content} $r->recv);
1602 $node->add_holdings($xml);
1605 $node->id($item_tag);
1606 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1607 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1608 $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1609 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1610 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1611 $node->link('unapi-id' => $item_tag) if ($flesh);
1619 return Apache2::Const::DECLINED if (-e $apache->filename);
1624 my $year = (gmtime())[5] + 1900;
1626 my $host = $cgi->virtual_host || $cgi->server_name;
1629 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1630 my $rel_name = $cgi->url(-relative=>1);
1631 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1634 my $url = $cgi->url(-path_info=>$add_path);
1635 my $root = (split 'browse', $url)[0];
1636 my $base = (split 'browse', $url)[0] . 'browse';
1637 my $unapi = (split 'browse', $url)[0] . 'unapi';
1639 my $path = $cgi->path_info;
1642 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1643 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1645 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1647 my $status = [$cgi->param('status')];
1648 my $cpLoc = [$cgi->param('copyLocation')];
1649 $site ||= $cgi->param('searchOrg');
1650 $page ||= $cgi->param('startPage') || 0;
1651 $page_size ||= $cgi->param('count') || 9;
1652 $thesauruses //= '';
1653 $thesauruses =~ s/\s//g;
1654 # protect against cats bouncing on the comma key...
1655 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1657 $page = 0 if ($page !~ /^-?\d+$/);
1658 $page_size = 9 if $page_size !~ /^\d+$/;
1660 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1661 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1663 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1664 warn "something's wrong...";
1665 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1669 $string = decode_utf8($string);
1670 $string =~ s/\+/ /go;
1674 if ($axis =~ /^authority/) {
1675 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1677 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1678 $method .= ".refs" if $refs;
1680 $tree = $supercat->request(
1689 $tree = $supercat->request(
1690 "open-ils.supercat.$axis.browse",
1700 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1702 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1703 print $header.$content;
1704 return Apache2::Const::OK;
1707 sub string_startwith {
1709 return Apache2::Const::DECLINED if (-e $apache->filename);
1714 my $year = (gmtime())[5] + 1900;
1716 my $host = $cgi->virtual_host || $cgi->server_name;
1719 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1720 my $rel_name = $cgi->url(-relative=>1);
1721 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1724 my $url = $cgi->url(-path_info=>$add_path);
1725 my $root = (split 'startwith', $url)[0];
1726 my $base = (split 'startwith', $url)[0] . 'startwith';
1727 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1729 my $path = $cgi->path_info;
1732 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1733 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1735 my $status = [$cgi->param('status')];
1736 my $cpLoc = [$cgi->param('copyLocation')];
1737 $site ||= $cgi->param('searchOrg');
1738 $page ||= $cgi->param('startPage') || 0;
1739 $page_size ||= $cgi->param('count') || 9;
1740 $thesauruses //= '';
1741 $thesauruses =~ s/\s//g;
1742 # protect against cats bouncing on the comma key...
1743 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1745 $page = 0 if ($page !~ /^-?\d+$/);
1746 $page_size = 9 if $page_size !~ /^\d+$/;
1748 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1749 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1751 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1752 warn "something's wrong...";
1753 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1757 $string = decode_utf8($string);
1758 $string =~ s/\+/ /go;
1762 if ($axis =~ /^authority/) {
1763 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1765 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1766 $method .= ".refs" if $refs;
1768 $tree = $supercat->request(
1777 $tree = $supercat->request(
1778 "open-ils.supercat.$axis.startwith",
1788 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1790 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1791 print $header.$content;
1792 return Apache2::Const::OK;
1795 sub item_age_browse {
1797 return Apache2::Const::DECLINED if (-e $apache->filename);
1802 my $year = (gmtime())[5] + 1900;
1804 my $host = $cgi->virtual_host || $cgi->server_name;
1807 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1808 my $rel_name = $cgi->url(-relative=>1);
1809 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1812 my $url = $cgi->url(-path_info=>$add_path);
1813 my $root = (split 'browse', $url)[0];
1814 my $base = (split 'browse', $url)[0] . 'browse';
1815 my $unapi = (split 'browse', $url)[0] . 'unapi';
1817 my $path = $cgi->path_info;
1820 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1821 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1823 unless ($axis eq 'item-age') {
1824 warn "something's wrong...";
1825 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1829 my $status = [$cgi->param('status')];
1830 my $cpLoc = [$cgi->param('copyLocation')];
1831 $site ||= $cgi->param('searchOrg') || '-';
1832 $page ||= $cgi->param('startPage') || 1;
1833 $page_size ||= $cgi->param('count') || 10;
1835 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1836 $page_size = 10 if $page_size !~ /^\d+$/;
1838 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1839 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1841 my $recs = $supercat->request(
1842 "open-ils.supercat.new_book_list",
1850 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1852 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1853 print $header.$content;
1854 return Apache2::Const::OK;
1857 our %qualifier_ids = (
1858 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1859 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1860 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1864 # Our authority search options are currently pretty impoverished;
1865 # just right-truncated string match on a few categories, or by
1867 our %nested_auth_qualifier_map = (
1869 id => { index => 'id', title => 'Record number'},
1870 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1871 title => { index => 'title', title => 'Uniform title'},
1872 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1873 topic => { index => 'topic', title => 'Topical term'},
1877 my $base_explain = <<XML;
1879 id="evergreen-sru-explain-full"
1880 authoritative="true"
1881 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1882 xmlns="http://explain.z3950.org/dtd/2.0/">
1883 <serverInfo transport="http" protocol="SRU" version="1.1">
1890 <title primary="true"/>
1891 <description primary="true"/>
1895 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1900 identifier="info:srw/schema/1/marcxml-v1.1"
1901 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1905 <title>MARC21Slim (marcxml)</title>
1910 <default type="numberOfRecords">10</default>
1911 <default type="contextSet">eg</default>
1912 <default type="index">keyword</default>
1913 <default type="relation">all</default>
1914 <default type="sortSchema">marcxml</default>
1915 <default type="retrieveSchema">marcxml</default>
1916 <setting type="maximumRecords">50</setting>
1917 <supports type="relationModifier">relevant</supports>
1918 <supports type="relationModifier">stem</supports>
1919 <supports type="relationModifier">fuzzy</supports>
1920 <supports type="relationModifier">word</supports>
1933 my $req = SRU::Request->newFromCGI( $cgi );
1934 my $resp = SRU::Response->newFromRequest( $req );
1936 # Find the org_unit shortname, if passed as part of the URL
1937 # http://example.com/opac/extras/sru/SHORTNAME
1938 my $url = $cgi->path_info;
1939 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1941 if ( $resp->type eq 'searchRetrieve' ) {
1943 # Older versions of Debian packages returned terms to us double-encoded,
1944 # so we had to forcefully double-decode them a second time with
1945 # an outer decode('utf8', $string) call; this seems to be resolved with
1946 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1947 my $cql_query = decode_utf8($req->query);
1948 my $search_string = decode_utf8($req->cql->toEvergreen);
1950 # Ensure the search string overrides the default site
1951 if ($shortname and $search_string !~ m#site:#) {
1952 $search_string .= " site:$shortname";
1955 my $offset = $req->startRecord;
1956 $offset-- if ($offset);
1959 my $limit = $req->maximumRecords;
1962 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1964 my $recs = $search->request(
1965 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1968 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1970 foreach my $record (@$bre) {
1971 my $marcxml = $record->marc;
1972 # Make the beast conform to a VDX-supported format
1973 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1974 # Trying to implement LIBSOL_852_A format; so much for standards
1976 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1977 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1979 # Force record leader to 'a' as our data is always UTF8
1980 # Avoids marc8_to_utf8 from being invoked with horrible results
1981 # on the off-chance the record leader isn't correct
1982 my $ldr = $marc->leader;
1983 substr($ldr, 9, 1, 'a');
1984 $marc->leader($ldr);
1986 # Expects the record ID in the 001
1987 $marc->delete_field($_) for ($marc->field('001'));
1988 if (!$marc->field('001')) {
1989 $marc->insert_fields_ordered(
1990 MARC::Field->new( '001', $record->id )
1993 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1994 foreach my $cn (keys %$bib_holdings) {
1995 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1996 $marc->insert_fields_ordered(
1999 a => $cp->{'location'},
2000 b => $bib_holdings->{$cn}->{'owning_lib'},
2002 d => $cp->{'circlib'},
2003 g => $cp->{'barcode'},
2004 n => $cp->{'status'},
2010 $marcxml = $marc->as_xml_record();
2011 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2015 SRU::Response::Record->new(
2016 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2017 recordData => $marcxml,
2018 recordPosition => ++$offset
2023 $resp->numberOfRecords($recs->{count});
2025 } elsif ( $resp->type eq 'explain' ) {
2026 return_sru_explain($cgi, $req, $resp, \$ex_doc,
2028 \%OpenILS::WWW::SuperCat::qualifier_ids
2032 SRU::Response::Record->new(
2033 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2034 recordData => $ex_doc
2039 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2040 print $U->entityize($resp->asXML) . "\n";
2041 return Apache2::Const::OK;
2046 package CQL::BooleanNode;
2050 my $left = $self->left();
2051 my $right = $self->right();
2052 my $leftStr = $left->toEvergreen;
2053 my $rightStr = $right->toEvergreen();
2055 my $op = '||' if uc $self->op() eq 'OR';
2058 return "$leftStr $rightStr";
2061 sub toEvergreenAuth {
2062 return toEvergreen(shift);
2065 package CQL::TermNode;
2069 my $qualifier = $self->getQualifier();
2070 my $term = $self->getTerm();
2071 my $relation = $self->getRelation();
2075 my ($qset, $qname) = split(/\./, $qualifier);
2077 # Per http://www.loc.gov/standards/sru/specs/cql.html
2078 # "All parts of CQL are case insensitive [...] If any case insensitive
2079 # part of CQL is specified with both upper and lower case, it is for
2080 # aesthetic purposes only."
2082 # So fold the qualifier and relation to lower case
2084 $qname = lc($qname);
2086 if ( exists($qualifier_map{$qset}{$qname}) ) {
2087 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2088 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2091 my @modifiers = $relation->getModifiers();
2093 my $base = $relation->getBase();
2094 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2097 foreach my $m ( @modifiers ) {
2098 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2104 $quote_it = 0 if ( $base eq 'all' );
2105 $term = maybeQuote($term) if $quote_it;
2108 croak( "Evergreen doesn't support the $base relations" );
2116 return "$qualifier:$term";
2119 sub toEvergreenAuth {
2121 my $qualifier = $self->getQualifier();
2122 my $term = $self->getTerm();
2123 my $relation = $self->getRelation();
2127 my ($qset, $qname) = split(/\./, $qualifier);
2129 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2130 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2131 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2134 return { qualifier => $qualifier, term => $term };
2139 sub sru_auth_search {
2144 my $req = SRU::Request->newFromCGI( $cgi );
2145 my $resp = SRU::Response->newFromRequest( $req );
2147 if ( $resp->type eq 'searchRetrieve' ) {
2148 return_auth_response($cgi, $req, $resp);
2149 } elsif ( $resp->type eq 'explain' ) {
2150 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2151 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2152 \%OpenILS::WWW::SuperCat::qualifier_ids
2156 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2157 print $U->entityize($resp->asXML) . "\n";
2158 return Apache2::Const::OK;
2161 sub explain_header {
2164 my $host = $cgi->virtual_host || $cgi->server_name;
2167 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2168 my $rel_name = $cgi->url(-relative=>1);
2169 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2171 my $base = $cgi->url(-base=>1);
2172 my $url = $cgi->url(-path_info=>$add_path);
2173 $url =~ s/^$base\///o;
2175 my $doc = $parser->parse_string($base_explain);
2176 my $e = $doc->documentElement;
2177 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2178 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2179 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2184 sub return_sru_explain {
2185 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2187 $index_map ||= \%qualifier_map;
2189 my ($doc, $e) = explain_header($cgi);
2190 for my $name ( keys %{$index_map} ) {
2192 my $identifier = $qualifier_ids->{ $name };
2194 next unless $identifier;
2196 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2197 $set_node->setAttribute( identifier => $identifier );
2198 $set_node->setAttribute( name => $name );
2200 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2201 for my $index ( sort keys %{$index_map->{$name}} ) {
2202 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2204 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2205 $map_node->appendChild( $name_node );
2207 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2209 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2210 $index_node->appendChild( $title_node );
2211 $index_node->appendChild( $map_node );
2213 $index_node->setAttribute( id => "$name.$index" );
2214 $title_node->appendText($index_map->{$name}{$index}{'title'});
2215 $name_node->setAttribute( set => $name );
2216 $name_node->appendText($index_map->{$name}{$index}{'index'});
2218 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2222 $$explain = $e->toString;
2226 SRU::Response::Record->new(
2227 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2228 recordData => $$explain
2234 sub return_auth_response {
2235 my ($cgi, $req, $resp) = @_;
2237 my $cql_query = decode_utf8($req->query);
2238 my $search = $req->cql->toEvergreenAuth;
2240 my $qualifier = decode_utf8($search->{qualifier});
2241 my $term = decode_utf8($search->{term});
2243 $log->info("SRU NAF search string [$cql_query] converted to "
2244 . "[$qualifier:$term]\n");
2246 my $page_size = $req->maximumRecords;
2249 # startwith deals with pages, so convert startRecord to a page number
2250 my $page = ($req->startRecord / $page_size) || 0;
2253 if ($qualifier eq "id") {
2254 $recs = [ int($term) ];
2256 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2258 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2259 $method .= ".refs" if $refs;
2261 $recs = $supercat->request(
2270 my $record_position = $req->startRecord;
2271 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2272 foreach my $record (@$recs) {
2273 my $marcxml = $cstore->request(
2274 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2278 SRU::Response::Record->new(
2279 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2280 recordData => $marcxml,
2281 recordPosition => ++$record_position
2286 $resp->numberOfRecords(scalar(@$recs));
2289 =head2 get_ou($org_unit)
2291 Returns an aou object for a given actor.org_unit shortname or ID.
2296 my $org = shift || '-';
2300 $org_unit = $actor->request(
2301 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2303 } elsif ($org !~ /^\d+$/o) {
2304 $org_unit = $actor->request(
2305 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2308 $org_unit = $actor->request(
2309 'open-ils.actor.org_unit_list.search' => id => $org