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;
33 my $log = 'OpenSRF::Utils::Logger';
34 my $U = 'OpenILS::Application::AppUtils';
36 # set the bootstrap config when this module is loaded
37 my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
39 $browse_types{call_number}{xml} = sub {
42 my $year = (gmtime())[5] + 1900;
45 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
48 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
49 $cn_class =~ s/Fieldmapper-//gso;
51 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
52 my $cn_lib = $cn->owning_lib->shortname;
53 my $cn_label = $cn->label;
55 $cn_label =~ s/\n//gos;
56 $cn_label =~ s/&/&/go;
57 $cn_label =~ s/'/'/go;
58 $cn_label =~ s/</</go;
59 $cn_label =~ s/>/>/go;
61 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
62 $ou_class =~ s/Fieldmapper-//gso;
64 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
65 my $ou_name = $cn->owning_lib->name;
67 $ou_name =~ s/\n//gos;
68 $ou_name =~ s/'/'/go;
70 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
71 $rec_class =~ s/Fieldmapper-//gso;
73 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
75 $content .= "<volume id='$cn_tag' lib='$cn_lib' label='$cn_label'>\n";
76 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
78 my $r_doc = $parser->parse_string($cn->record->marc);
79 $r_doc->documentElement->setAttribute( id => $rec_tag );
80 $content .= $U->entityize($r_doc->documentElement->toString);
82 $content .= "</volume>\n";
85 $content .= "</volumes>\n";
86 return ("Content-type: application/xml\n\n",$content);
90 $browse_types{call_number}{html} = sub {
95 if (!$cn_browse_xslt) {
96 $cn_browse_xslt = $parser->parse_file(
97 OpenSRF::Utils::SettingsClient
99 ->config_value( dirs => 'xsl' ).
102 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
105 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
108 "Content-type: text/html\n\n",
110 $cn_browse_xslt->transform(
111 $parser->parse_string( $xml ),
126 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
128 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
129 Fieldmapper->import(IDL => $idl);
131 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
132 $actor = OpenSRF::AppSession->create('open-ils.actor');
133 $search = OpenSRF::AppSession->create('open-ils.search');
134 $parser = new XML::LibXML;
135 $xslt = new XML::LibXSLT;
137 $cn_browse_xslt = $parser->parse_file(
138 OpenSRF::Utils::SettingsClient
140 ->config_value( dirs => 'xsl' ).
144 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
146 %qualifier_map = %{$supercat
147 ->request("open-ils.supercat.biblio.search_aliases")
150 my %attribute_desc = (
151 site => 'Evergreen Site Code (shortname)',
152 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
153 dir => 'Sort direction (asc|desc)',
154 available => 'Filter to available (true|false)',
157 # Append the non-search-alias attributes to the qualifier map
174 preferred_language_weight
175 preferred_language_multiplier
177 $qualifier_map{'eg'}{$_}{'index'} = $_;
178 if (exists $attribute_desc{$_}) {
179 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
181 $qualifier_map{'eg'}{$_}{'title'} = $_;
186 ->request("open-ils.supercat.record.formats")
189 $list = [ map { (keys %$_)[0] } @$list ];
190 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
192 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
193 for my $record_browse_format ( @$list ) {
195 my $__f = $record_browse_format;
196 my $__a = $browse_axis;
198 $browse_types{$__a}{$__f} = sub {
199 my $record_list = shift;
202 my $real_format = shift || $__f;
207 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
208 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
209 $feed->root( "$base/../" );
211 $feed->link( next => $next => $feed->type );
212 $feed->link( previous => $prev => $feed->type );
215 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
223 for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
224 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
227 my $__a = $browse_axis;
229 $browse_types{$__a}{$__f} = sub {
230 my $record_list = shift;
233 my $real_format = shift || $__f;
238 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
239 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
240 $feed->root( "$base/../" );
241 $feed->link( next => $next => $feed->type );
242 $feed->link( previous => $prev => $feed->type );
245 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
254 =head2 parse_feed_type($type)
256 Determines whether and how a given feed type needs to be "fleshed out"
257 with holdings information.
259 The feed type could end with the string "-full", in which case we want
260 to return call numbers, copies, and URIS.
262 Or the feed type could be "-uris", in which case we want to return
263 call numbers and URIS.
265 Otherwise, we won't return any holdings.
269 sub parse_feed_type {
272 if ($type =~ /-full$/o) {
276 if ($type =~ /-uris$/o) {
280 # Otherwise, we'll return just the facts, ma'am
284 =head2 supercat_format($format_hashref, $format_type)
286 Given a reference to a hash containing the namespace_uri,
287 docs, and schema location attributes for a set of formats,
288 generate the XML description required by the supercat service.
290 We derive the base type from the format type so that we do not
291 have to populate the hash with redundant information.
295 sub supercat_format {
299 (my $base_type = $type) =~ s/(-full|-uris)$//o;
301 my $format = "<format><name>$type</name><type>application/xml</type>";
303 for my $part ( qw/namespace_uri docs schema_location/ ) {
304 $format .= "<$part>$$h{$base_type}{$part}</$part>"
305 if ($$h{$base_type}{$part});
308 $format .= '</format>';
313 =head2 unapi_format($format_hashref, $format_type)
315 Given a reference to a hash containing the namespace_uri,
316 docs, and schema location attributes for a set of formats,
317 generate the XML description required by the supercat service.
319 We derive the base type from the format type so that we do not
320 have to populate the hash with redundant information.
328 (my $base_type = $type) =~ s/(-full|-uris)$//o;
330 my $format = "<format name='$type' type='application/xml'";
332 for my $part ( qw/namespace_uri docs schema_location/ ) {
333 $format .= " $part='$$h{$base_type}{$part}'"
334 if ($$h{$base_type}{$part});
346 return Apache2::Const::DECLINED if (-e $apache->filename);
348 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
351 ->request("open-ils.supercat.oisbn", $isbn)
354 print "Content-type: application/xml; charset=utf-8\n\n";
355 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
357 unless (exists $$list{metarecord}) {
359 return Apache2::Const::OK;
362 print "<idlist metarecord='$$list{metarecord}'>\n";
364 for ( keys %{ $$list{record_list} } ) {
365 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
366 print " <isbn record='$_'>$o</isbn>\n"
371 return Apache2::Const::OK;
377 return Apache2::Const::DECLINED if (-e $apache->filename);
382 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
383 my $rel_name = $cgi->url(-relative=>1);
384 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
387 my $url = $cgi->url(-path_info=>$add_path);
388 my $root = (split 'unapi', $url)[0];
389 my $base = (split 'unapi', $url)[0] . 'unapi';
392 my $uri = $cgi->param('id') || '';
393 my $host = $cgi->virtual_host || $cgi->server_name;
395 my $skin = $cgi->param('skin') || 'default';
396 my $locale = $cgi->param('locale') || 'en-US';
398 # Enable localized results of copy status, etc
399 $supercat->session_locale($locale);
401 my $format = $cgi->param('format');
402 my $flesh_feed = parse_feed_type($format);
403 (my $base_format = $format) =~ s/(-full|-uris)$//o;
404 my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
407 my $body = "Content-type: application/xml; charset=utf-8\n\n";
409 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
412 ($lib,$depth) = split('/', $4);
414 $type = 'metarecord' if ($1 =~ /^m/o);
415 $type = 'authority' if ($1 =~ /^authority/o);
418 ->request("open-ils.supercat.$type.formats")
421 if ($type eq 'record' or $type eq 'isbn') {
422 $body .= <<" FORMATS";
424 <format name='opac' type='text/html'/>
425 <format name='html' type='text/html'/>
426 <format name='htmlholdings' type='text/html'/>
427 <format name='holdings_xml' type='application/xml'/>
428 <format name='holdings_xml-full' type='application/xml'/>
429 <format name='html-full' type='text/html'/>
430 <format name='htmlholdings-full' type='text/html'/>
431 <format name='marctxt' type='text/plain'/>
432 <format name='ris' type='text/plain'/>
434 } elsif ($type eq 'metarecord') {
435 $body .= <<" FORMATS";
437 <format name='opac' type='text/html'/>
440 $body .= <<" FORMATS";
446 my ($type) = keys %$h;
447 $body .= unapi_format($h, $type);
449 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
450 $body .= unapi_format($h, "$type-full");
451 $body .= unapi_format($h, "$type-uris");
455 $body .= "</formats>\n";
459 ->request("open-ils.supercat.$type.formats")
464 ->request("open-ils.supercat.metarecord.formats")
468 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
469 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
471 $body .= <<" FORMATS";
473 <format name='opac' type='text/html'/>
474 <format name='html' type='text/html'/>
475 <format name='htmlholdings' type='text/html'/>
476 <format name='holdings_xml' type='application/xml'/>
477 <format name='holdings_xml-full' type='application/xml'/>
478 <format name='html-full' type='text/html'/>
479 <format name='htmlholdings-full' type='text/html'/>
480 <format name='marctxt' type='text/plain'/>
481 <format name='ris' type='text/plain'/>
486 my ($type) = keys %$h;
487 $body .= "\t" . unapi_format($h, $type);
489 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
490 $body .= "\t" . unapi_format($h, "$type-full");
491 $body .= "\t" . unapi_format($h, "$type-uris");
495 $body .= "</formats>\n";
499 return Apache2::Const::OK;
503 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
507 ($lib,$depth) = split('/', $4);
509 $type = 'metarecord' if ($scheme =~ /^metabib/o);
510 $type = 'isbn' if ($scheme =~ /^isbn/o);
511 $type = 'acp' if ($scheme =~ /^asset-copy/o);
512 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
513 $type = 'auri' if ($scheme =~ /^asset-uri/o);
514 $type = 'authority' if ($scheme =~ /^authority/o);
515 $command = 'retrieve';
516 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
520 $paging = [split ',', $paging];
525 if (!$lib || $lib eq '-') {
526 $lib = $actor->request(
527 'open-ils.actor.org_unit_list.search' => parent_ou => undef
528 )->gather(1)->[0]->shortname;
531 my ($lib_object,$lib_id,$ou_types,$lib_depth);
532 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
533 $lib_object = $actor->request(
534 'open-ils.actor.org_unit_list.search' => shortname => $lib
536 $lib_id = $lib_object->id;
538 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
539 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
542 if ($command eq 'browse') {
543 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
547 if ($type eq 'isbn') {
548 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
550 # Escape user input before display
551 $command = CGI::escapeHTML($command);
552 $id = CGI::escapeHTML($id);
553 $type = CGI::escapeHTML($type);
554 $format = CGI::escapeHTML(decode_utf8($format));
556 print "Content-type: text/html; charset=utf-8\n\n";
557 $apache->custom_response( 404, <<" HTML");
560 <title>Type [$type] with id [$id] not found!</title>
564 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
575 { (keys(%$_))[0] eq $base_format }
576 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
578 { $_ eq $base_format }
579 qw/opac html htmlholdings marctxt ris holdings_xml/
581 # Escape user input before display
582 $format = CGI::escapeHTML($format);
583 $type = CGI::escapeHTML($type);
585 print "Content-type: text/html; charset=utf-8\n\n";
586 $apache->custom_response( 406, <<" HTML");
589 <title>Invalid format [$format] for type [$type]!</title>
593 <center>Sorry, format $format is not valid for type $type.</center>
600 if ($format eq 'opac') {
601 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
602 if ($type eq 'metarecord');
603 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
604 if ($type eq 'record');
606 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
607 my $feed = create_record_feed(
618 # Escape user input before display
619 $command = CGI::escapeHTML($command);
620 $id = CGI::escapeHTML($id);
621 $type = CGI::escapeHTML($type);
622 $format = CGI::escapeHTML(decode_utf8($format));
624 print "Content-type: text/html; charset=utf-8\n\n";
625 $apache->custom_response( 404, <<" HTML");
628 <title>Type [$type] with id [$id] not found!</title>
632 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
640 $feed->creator($host);
642 $feed->link( unapi => $base) if ($flesh_feed);
644 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
645 print $U->entityize($feed->toString) . "\n";
647 return Apache2::Const::OK;
650 my $method = "open-ils.supercat.$type.$base_format.$command";
652 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
654 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
655 # however, we can have it carry extra options like no_record! (comma separated)
656 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
658 my $req = $supercat->request($method,@params);
659 my $data = $req->gather();
661 if ($req->failed || !$data) {
662 # Escape user input before display
663 $command = CGI::escapeHTML($command);
664 $id = CGI::escapeHTML($id);
665 $type = CGI::escapeHTML($type);
666 $format = CGI::escapeHTML(decode_utf8($format));
668 print "Content-type: text/html; charset=utf-8\n\n";
669 $apache->custom_response( 404, <<" HTML");
672 <title>$type $id not found!</title>
676 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
683 print "Content-type: application/xml; charset=utf-8\n\n$data";
685 if ($base_format eq 'holdings_xml') {
686 while (my $c = $req->recv) {
691 return Apache2::Const::OK;
697 return Apache2::Const::DECLINED if (-e $apache->filename);
702 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
703 my $rel_name = $cgi->url(-relative=>1);
704 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
707 my $url = $cgi->url(-path_info=>$add_path);
708 my $root = (split 'supercat', $url)[0];
709 my $base = (split 'supercat', $url)[0] . 'supercat';
710 my $unapi = (split 'supercat', $url)[0] . 'unapi';
712 my $host = $cgi->virtual_host || $cgi->server_name;
714 my $path = $cgi->path_info;
715 my ($id,$type,$format,$command) = reverse split '/', $path;
716 my $flesh_feed = parse_feed_type($format);
717 (my $base_format = $format) =~ s/(-full|-uris)$//o;
719 my $skin = $cgi->param('skin') || 'default';
720 my $locale = $cgi->param('locale') || 'en-US';
722 # Enable localized results of copy status, etc
723 $supercat->session_locale($locale);
725 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
726 print "Content-type: application/xml; charset=utf-8\n";
729 ->request("open-ils.supercat.$1.formats")
737 <type>text/html</type>
740 if ($1 eq 'record' or $1 eq 'isbn') {
742 <name>htmlholdings</name>
743 <type>text/html</type>
747 <type>text/html</type>
750 <name>htmlholdings-full</name>
751 <type>text/html</type>
754 <name>html-full</name>
755 <type>text/html</type>
759 <type>text/plain</type>
763 <type>text/plain</type>
768 my ($type) = keys %$h;
769 print supercat_format($h, $type);
771 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
772 print supercat_format($h, "$type-full");
773 print supercat_format($h, "$type-uris");
778 print "</formats>\n";
780 return Apache2::Const::OK;
784 ->request("open-ils.supercat.record.formats")
789 ->request("open-ils.supercat.metarecord.formats")
793 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
794 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
799 <type>text/html</type>
802 <name>htmlholdings</name>
803 <type>text/html</type>
807 <type>text/html</type>
810 <name>htmlholdings-full</name>
811 <type>text/html</type>
814 <name>html-full</name>
815 <type>text/html</type>
819 <type>text/plain</type>
823 <type>text/plain</type>
827 my ($type) = keys %$h;
828 print supercat_format($h, $type);
830 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
831 print supercat_format($h, "$type-full");
832 print supercat_format($h, "$type-uris");
837 print "</formats>\n";
840 return Apache2::Const::OK;
843 if ($format eq 'opac') {
844 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
845 if ($type eq 'metarecord');
846 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
847 if ($type eq 'record');
850 } elsif ($base_format eq 'marc21') {
854 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
856 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
861 # Escape user input before display
862 $id = CGI::escapeHTML($id);
864 print "Content-type: text/html; charset=utf-8\n\n";
865 $apache->custom_response( 404, <<" HTML");
872 <center>Couldn't fetch $id as MARC21.</center>
879 return Apache2::Const::OK;
881 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
882 my $feed = create_record_feed(
890 $feed->creator($host);
894 $feed->link( unapi => $base) if ($flesh_feed);
896 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
897 print $U->entityize($feed->toString) . "\n";
899 return Apache2::Const::OK;
902 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
906 # Escape user input before display
907 $command = CGI::escapeHTML($command);
908 $id = CGI::escapeHTML($id);
909 $type = CGI::escapeHTML($type);
910 $format = CGI::escapeHTML(decode_utf8($format));
912 print "Content-type: text/html; charset=utf-8\n\n";
913 $apache->custom_response( 404, <<" HTML");
916 <title>$type $id not found!</title>
920 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
927 print "Content-type: application/xml; charset=utf-8\n\n";
928 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
930 return Apache2::Const::OK;
936 return Apache2::Const::DECLINED if (-e $apache->filename);
940 my $year = (gmtime())[5] + 1900;
941 my $host = $cgi->virtual_host || $cgi->server_name;
944 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
945 my $rel_name = $cgi->url(-relative=>1);
946 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
949 my $url = $cgi->url(-path_info=>$add_path);
950 my $root = (split 'feed', $url)[0] . '/';
951 my $base = (split 'bookbag', $url)[0] . '/bookbag';
952 my $unapi = (split 'feed', $url)[0] . '/unapi';
954 my $skin = $cgi->param('skin') || 'default';
955 my $locale = $cgi->param('locale') || 'en-US';
956 my $org = $cgi->param('searchOrg');
958 # Enable localized results of copy status, etc
959 $supercat->session_locale($locale);
961 my $org_unit = get_ou($org);
962 my $scope = "l=" . $org_unit->[0]->id . "&";
964 $root =~ s{(?<!http:)//}{/}go;
965 $base =~ s{(?<!http:)//}{/}go;
966 $unapi =~ s{(?<!http:)//}{/}go;
968 my $path = $cgi->path_info;
969 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
971 my ($id,$type) = reverse split '/', $path;
972 my $flesh_feed = parse_feed_type($type);
974 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
975 return Apache2::Const::NOT_FOUND unless($bucket);
977 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
978 if ($type eq 'opac') {
979 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
980 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
985 my $feed = create_record_feed(
988 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
990 $org_unit->[0]->shortname,
995 $feed->id($bucket_tag);
997 $feed->title("Items in Book Bag [".$bucket->name."]");
998 $feed->creator($host);
1001 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1002 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1003 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1004 $feed->link(unapi => $unapi);
1008 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1009 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1014 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1015 print $U->entityize($feed->toString) . "\n";
1017 return Apache2::Const::OK;
1022 return Apache2::Const::DECLINED if (-e $apache->filename);
1026 my $year = (gmtime())[5] + 1900;
1027 my $host = $cgi->virtual_host || $cgi->server_name;
1030 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1031 my $rel_name = $cgi->url(-relative=>1);
1032 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1035 my $url = $cgi->url(-path_info=>$add_path);
1036 my $root = (split 'feed', $url)[0];
1037 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1038 my $unapi = (split 'feed', $url)[0] . 'unapi';
1040 my $skin = $cgi->param('skin') || 'default';
1041 my $locale = $cgi->param('locale') || 'en-US';
1042 my $org = $cgi->param('searchOrg');
1044 # Enable localized results of copy status, etc
1045 $supercat->session_locale($locale);
1047 my $org_unit = get_ou($org);
1048 my $scope = "l=" . $org_unit->[0]->id . "&";
1050 my $path = $cgi->path_info;
1051 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1053 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1055 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1056 my $flesh_feed = parse_feed_type($type);
1059 $limit = 10 if $limit !~ /^\d+$/;
1061 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1063 #if ($type eq 'opac') {
1064 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1065 # join('&', map { "rl=" . $_ } @$list) .
1070 my $search = 'record';
1071 if ($rtype eq 'authority') {
1072 $search = 'authority';
1074 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1078 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1080 $feed->title("$limit most recent $rtype ${axis}s");
1083 $feed->creator($host);
1086 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1087 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1088 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1089 $feed->link(unapi => $unapi);
1093 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1094 join('&', map { 'rl=' . $_} @$list ),
1099 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1100 print $U->entityize($feed->toString) . "\n";
1102 return Apache2::Const::OK;
1105 sub opensearch_osd {
1106 my $version = shift;
1111 if ($version eq '1.0') {
1113 Content-type: application/opensearchdescription+xml; charset=utf-8
1115 <?xml version="1.0" encoding="UTF-8"?>
1116 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1117 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1118 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1119 <ShortName>$lib</ShortName>
1120 <LongName>Search $lib</LongName>
1121 <Description>Search the $lib OPAC by $class.</Description>
1122 <Tags>$lib book library</Tags>
1123 <SampleSearch>harry+potter</SampleSearch>
1124 <Developer>Mike Rylander for GPLS/PINES</Developer>
1125 <Contact>feedback\@open-ils.org</Contact>
1126 <SyndicationRight>open</SyndicationRight>
1127 <AdultContent>false</AdultContent>
1128 </OpenSearchDescription>
1132 Content-type: application/opensearchdescription+xml; charset=utf-8
1134 <?xml version="1.0" encoding="UTF-8"?>
1135 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1136 <ShortName>$lib</ShortName>
1137 <Description>Search the $lib OPAC by $class.</Description>
1138 <Tags>$lib book library</Tags>
1139 <Url type="application/rss+xml"
1140 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1141 <Url type="application/atom+xml"
1142 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1143 <Url type="application/x-mods3+xml"
1144 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1145 <Url type="application/x-mods+xml"
1146 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1147 <Url type="application/x-marcxml+xml"
1148 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1149 <Url type="text/html"
1150 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1151 <LongName>Search $lib</LongName>
1152 <Query role="example" searchTerms="harry+potter" />
1153 <Developer>Mike Rylander for GPLS/PINES</Developer>
1154 <Contact>feedback\@open-ils.org</Contact>
1155 <SyndicationRight>open</SyndicationRight>
1156 <AdultContent>false</AdultContent>
1157 <Language>en-US</Language>
1158 <OutputEncoding>UTF-8</OutputEncoding>
1159 <InputEncoding>UTF-8</InputEncoding>
1160 </OpenSearchDescription>
1164 return Apache2::Const::OK;
1167 sub opensearch_feed {
1169 return Apache2::Const::DECLINED if (-e $apache->filename);
1172 my $year = (gmtime())[5] + 1900;
1174 my $host = $cgi->virtual_host || $cgi->server_name;
1177 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1178 my $rel_name = $cgi->url(-relative=>1);
1179 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1182 my $url = $cgi->url(-path_info=>$add_path);
1183 my $root = (split 'opensearch', $url)[0];
1184 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1185 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1187 my $path = $cgi->path_info;
1188 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1190 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1196 if (!$lib || $lib eq '-') {
1197 $lib = $actor->request(
1198 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1199 )->gather(1)->[0]->shortname;
1202 if ($class eq '-') {
1206 return opensearch_osd($version, $lib, $class, $base);
1210 my $page = $cgi->param('startPage') || 1;
1211 my $offset = $cgi->param('startIndex') || 1;
1212 my $limit = $cgi->param('count') || 10;
1214 $page = 1 if ($page !~ /^\d+$/);
1215 $offset = 1 if ($offset !~ /^\d+$/);
1216 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1219 $offset = ($page - 1) * $limit;
1224 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1225 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1227 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1228 $lang = '' if ($lang eq '*');
1230 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1232 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1235 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1236 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1238 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1241 $type = $cgi->param('responseType') if $cgi->param('responseType');
1244 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1248 my $kwt = $cgi->param('kw');
1249 my $tit = $cgi->param('ti');
1250 my $aut = $cgi->param('au');
1251 my $sut = $cgi->param('su');
1252 my $set = $cgi->param('se');
1254 $terms .= " " if ($terms && $kwt);
1255 $terms .= "keyword: $kwt" if ($kwt);
1256 $terms .= " " if ($terms && $tit);
1257 $terms .= "title: $tit" if ($tit);
1258 $terms .= " " if ($terms && $aut);
1259 $terms .= "author: $aut" if ($aut);
1260 $terms .= " " if ($terms && $sut);
1261 $terms .= "subject: $sut" if ($sut);
1262 $terms .= " " if ($terms && $set);
1263 $terms .= "series: $set" if ($set);
1265 if ($version eq '1.0') {
1267 } elsif ($type eq '-') {
1270 my $flesh_feed = parse_feed_type($type);
1272 $terms = decode_utf8($terms);
1273 $lang = 'eng' if ($lang eq 'en-US');
1275 $log->debug("OpenSearch terms: $terms");
1277 my $org_unit = get_ou($org);
1279 # Apostrophes break search and get indexed as spaces anyway
1280 my $safe_terms = $terms;
1281 $safe_terms =~ s{'}{ }go;
1283 my $recs = $search->request(
1284 'open-ils.search.biblio.multiclass.query' => {
1285 org_unit => $org_unit->[0]->id,
1289 sort_dir => $sortdir,
1290 default_class => $class,
1291 ($lang ? ( 'language' => $lang ) : ()),
1292 } => $safe_terms => 1
1295 $log->debug("Hits for [$terms]: $recs->{count}");
1297 my $feed = create_record_feed(
1300 [ map { $_->[0] } @{$recs->{ids}} ],
1307 $log->debug("Feed created...");
1311 $feed->search($safe_terms);
1312 $feed->class($class);
1314 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1316 $feed->creator($host);
1319 $feed->_create_node(
1320 $feed->{item_xpath},
1321 'http://a9.com/-/spec/opensearch/1.1/',
1326 $feed->_create_node(
1327 $feed->{item_xpath},
1328 'http://a9.com/-/spec/opensearch/1.1/',
1333 $feed->_create_node(
1334 $feed->{item_xpath},
1335 'http://a9.com/-/spec/opensearch/1.1/',
1340 $log->debug("...basic feed data added...");
1344 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1345 'application/opensearch+xml'
1346 ) if ($offset + $limit < $recs->{count});
1350 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1351 'application/opensearch+xml'
1356 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1357 'application/opensearch+xml'
1362 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1363 'application/rss+xml'
1368 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1369 'application/atom+xml'
1374 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1380 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1384 $feed->link( 'unapi-server' => $unapi);
1386 $log->debug("...feed links added...");
1390 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1391 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1395 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1396 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1398 $log->debug("...and feed returned.");
1400 return Apache2::Const::OK;
1403 sub create_record_feed {
1406 my $records = shift;
1409 my $lib = uc(shift()) || '-';
1416 my $base = $cgi->url;
1417 my $host = $cgi->virtual_host || $cgi->server_name;
1419 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1423 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1425 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1427 $type =~ s/(-full|-uris)$//o;
1429 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1430 $feed->base($base) if ($flesh);
1431 $feed->unapi($unapi) if ($flesh);
1433 $type = 'atom' if ($type eq 'html');
1434 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1436 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1439 for my $record (@$records) {
1440 next unless($record);
1442 #my $rec = $record->id;
1445 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1446 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1447 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1448 $item_tag .= "/$depth" if (defined($depth));
1450 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1452 my $xml = $supercat->request(
1453 "open-ils.supercat.$search.$type.retrieve",
1458 my $node = $feed->add_item($xml);
1462 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0 || $flesh eq 'uris')) {
1463 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1464 while ( !$r->complete ) {
1465 $xml .= join('', map {$_->content} $r->recv);
1467 $xml .= join('', map {$_->content} $r->recv);
1468 $node->add_holdings($xml);
1471 $node->id($item_tag);
1472 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1473 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0 || $flesh eq 'uris');
1474 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0 || $flesh eq 'uris');
1475 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1476 $node->link('unapi-id' => $item_tag) if ($flesh);
1484 return Apache2::Const::DECLINED if (-e $apache->filename);
1487 my $year = (gmtime())[5] + 1900;
1489 my $host = $cgi->virtual_host || $cgi->server_name;
1492 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1493 my $rel_name = $cgi->url(-relative=>1);
1494 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1497 my $url = $cgi->url(-path_info=>$add_path);
1498 my $root = (split 'browse', $url)[0];
1499 my $base = (split 'browse', $url)[0] . 'browse';
1500 my $unapi = (split 'browse', $url)[0] . 'unapi';
1502 my $path = $cgi->path_info;
1505 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1506 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1508 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1510 my $status = [$cgi->param('status')];
1511 my $cpLoc = [$cgi->param('copyLocation')];
1512 $site ||= $cgi->param('searchOrg');
1513 $page ||= $cgi->param('startPage') || 0;
1514 $page_size ||= $cgi->param('count') || 9;
1516 $page = 0 if ($page !~ /^-?\d+$/);
1517 $page_size = 9 if $page_size !~ /^\d+$/;
1519 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1520 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1522 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1523 warn "something's wrong...";
1524 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1528 $string = decode_utf8($string);
1529 $string =~ s/\+/ /go;
1532 my $tree = $supercat->request(
1533 "open-ils.supercat.$axis.browse",
1535 (($axis =~ /^authority/) ? () : ($site)),
1542 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1544 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1545 print $header.$content;
1546 return Apache2::Const::OK;
1549 sub string_startwith {
1551 return Apache2::Const::DECLINED if (-e $apache->filename);
1554 my $year = (gmtime())[5] + 1900;
1556 my $host = $cgi->virtual_host || $cgi->server_name;
1559 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1560 my $rel_name = $cgi->url(-relative=>1);
1561 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1564 my $url = $cgi->url(-path_info=>$add_path);
1565 my $root = (split 'startwith', $url)[0];
1566 my $base = (split 'startwith', $url)[0] . 'startwith';
1567 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1569 my $path = $cgi->path_info;
1572 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1573 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1575 my $status = [$cgi->param('status')];
1576 my $cpLoc = [$cgi->param('copyLocation')];
1577 $site ||= $cgi->param('searchOrg');
1578 $page ||= $cgi->param('startPage') || 0;
1579 $page_size ||= $cgi->param('count') || 9;
1581 $page = 0 if ($page !~ /^-?\d+$/);
1582 $page_size = 9 if $page_size !~ /^\d+$/;
1584 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1585 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1587 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1588 warn "something's wrong...";
1589 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1593 $string = decode_utf8($string);
1594 $string =~ s/\+/ /go;
1597 my $tree = $supercat->request(
1598 "open-ils.supercat.$axis.startwith",
1600 (($axis =~ /^authority/) ? () : ($site)),
1607 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1609 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1610 print $header.$content;
1611 return Apache2::Const::OK;
1614 sub item_age_browse {
1616 return Apache2::Const::DECLINED if (-e $apache->filename);
1619 my $year = (gmtime())[5] + 1900;
1621 my $host = $cgi->virtual_host || $cgi->server_name;
1624 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1625 my $rel_name = $cgi->url(-relative=>1);
1626 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1629 my $url = $cgi->url(-path_info=>$add_path);
1630 my $root = (split 'browse', $url)[0];
1631 my $base = (split 'browse', $url)[0] . 'browse';
1632 my $unapi = (split 'browse', $url)[0] . 'unapi';
1634 my $path = $cgi->path_info;
1637 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1638 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1640 unless ($axis eq 'item-age') {
1641 warn "something's wrong...";
1642 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1646 my $status = [$cgi->param('status')];
1647 my $cpLoc = [$cgi->param('copyLocation')];
1648 $site ||= $cgi->param('searchOrg') || '-';
1649 $page ||= $cgi->param('startPage') || 1;
1650 $page_size ||= $cgi->param('count') || 10;
1652 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1653 $page_size = 10 if $page_size !~ /^\d+$/;
1655 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1656 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1658 my $recs = $supercat->request(
1659 "open-ils.supercat.new_book_list",
1667 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1669 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1670 print $header.$content;
1671 return Apache2::Const::OK;
1674 our %qualifier_ids = (
1675 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1676 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1677 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1681 # Our authority search options are currently pretty impoverished;
1682 # just right-truncated string match on a few categories, or by
1684 our %nested_auth_qualifier_map = (
1686 id => { index => 'id', title => 'Record number'},
1687 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1688 title => { index => 'title', title => 'Uniform title'},
1689 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1690 topic => { index => 'topic', title => 'Topical term'},
1694 my $base_explain = <<XML;
1696 id="evergreen-sru-explain-full"
1697 authoritative="true"
1698 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1699 xmlns="http://explain.z3950.org/dtd/2.0/">
1700 <serverInfo transport="http" protocol="SRU" version="1.1">
1707 <title primary="true"/>
1708 <description primary="true"/>
1712 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1717 identifier="info:srw/schema/1/marcxml-v1.1"
1718 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1722 <title>MARC21Slim (marcxml)</title>
1727 <default type="numberOfRecords">10</default>
1728 <default type="contextSet">eg</default>
1729 <default type="index">keyword</default>
1730 <default type="relation">all</default>
1731 <default type="sortSchema">marcxml</default>
1732 <default type="retrieveSchema">marcxml</default>
1733 <setting type="maximumRecords">50</setting>
1734 <supports type="relationModifier">relevant</supports>
1735 <supports type="relationModifier">stem</supports>
1736 <supports type="relationModifier">fuzzy</supports>
1737 <supports type="relationModifier">word</supports>
1748 my $req = SRU::Request->newFromCGI( $cgi );
1749 my $resp = SRU::Response->newFromRequest( $req );
1751 # Find the org_unit shortname, if passed as part of the URL
1752 # http://example.com/opac/extras/sru/SHORTNAME
1753 my $url = $cgi->path_info;
1754 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1756 if ( $resp->type eq 'searchRetrieve' ) {
1758 # Older versions of Debian packages returned terms to us double-encoded,
1759 # so we had to forcefully double-decode them a second time with
1760 # an outer decode('utf8', $string) call; this seems to be resolved with
1761 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1762 my $cql_query = decode_utf8($req->query);
1763 my $search_string = decode_utf8($req->cql->toEvergreen);
1765 # Ensure the search string overrides the default site
1766 if ($shortname and $search_string !~ m#site:#) {
1767 $search_string .= " site:$shortname";
1770 my $offset = $req->startRecord;
1771 $offset-- if ($offset);
1774 my $limit = $req->maximumRecords;
1777 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1779 my $recs = $search->request(
1780 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1783 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1785 foreach my $record (@$bre) {
1786 my $marcxml = $record->marc;
1787 # Make the beast conform to a VDX-supported format
1788 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1789 # Trying to implement LIBSOL_852_A format; so much for standards
1791 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1792 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1794 # Force record leader to 'a' as our data is always UTF8
1795 # Avoids marc8_to_utf8 from being invoked with horrible results
1796 # on the off-chance the record leader isn't correct
1797 my $ldr = $marc->leader;
1798 substr($ldr, 9, 1, 'a');
1799 $marc->leader($ldr);
1801 # Expects the record ID in the 001
1802 $marc->delete_field($_) for ($marc->field('001'));
1803 if (!$marc->field('001')) {
1804 $marc->insert_fields_ordered(
1805 MARC::Field->new( '001', $record->id )
1808 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1809 foreach my $cn (keys %$bib_holdings) {
1810 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1811 $marc->insert_fields_ordered(
1814 a => $cp->{'location'},
1815 b => $bib_holdings->{$cn}->{'owning_lib'},
1817 d => $cp->{'circlib'},
1818 g => $cp->{'barcode'},
1819 n => $cp->{'status'},
1825 # Ensure the data is encoded as UTF8 before we hand it off
1826 $marcxml = encode_utf8($marc->as_xml_record());
1827 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1831 SRU::Response::Record->new(
1832 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1833 recordData => $marcxml,
1834 recordPosition => ++$offset
1839 $resp->numberOfRecords($recs->{count});
1841 } elsif ( $resp->type eq 'explain' ) {
1842 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1844 \%OpenILS::WWW::SuperCat::qualifier_ids
1848 SRU::Response::Record->new(
1849 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1850 recordData => $ex_doc
1855 print $cgi->header( -type => 'application/xml' );
1856 print $U->entityize($resp->asXML) . "\n";
1857 return Apache2::Const::OK;
1862 package CQL::BooleanNode;
1866 my $left = $self->left();
1867 my $right = $self->right();
1868 my $leftStr = $left->toEvergreen;
1869 my $rightStr = $right->toEvergreen();
1871 my $op = '||' if uc $self->op() eq 'OR';
1874 return "$leftStr $rightStr";
1877 sub toEvergreenAuth {
1878 return toEvergreen(shift);
1881 package CQL::TermNode;
1885 my $qualifier = $self->getQualifier();
1886 my $term = $self->getTerm();
1887 my $relation = $self->getRelation();
1891 my ($qset, $qname) = split(/\./, $qualifier);
1893 if ( exists($qualifier_map{$qset}{$qname}) ) {
1894 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1895 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1898 my @modifiers = $relation->getModifiers();
1900 my $base = $relation->getBase();
1901 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1904 foreach my $m ( @modifiers ) {
1905 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1911 $quote_it = 0 if ( $base eq 'all' );
1912 $term = maybeQuote($term) if $quote_it;
1915 croak( "Evergreen doesn't support the $base relations" );
1923 return "$qualifier:$term";
1926 sub toEvergreenAuth {
1928 my $qualifier = $self->getQualifier();
1929 my $term = $self->getTerm();
1930 my $relation = $self->getRelation();
1934 my ($qset, $qname) = split(/\./, $qualifier);
1936 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1937 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1938 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1941 return { qualifier => $qualifier, term => $term };
1946 sub sru_auth_search {
1949 my $req = SRU::Request->newFromCGI( $cgi );
1950 my $resp = SRU::Response->newFromRequest( $req );
1952 if ( $resp->type eq 'searchRetrieve' ) {
1953 return_auth_response($cgi, $req, $resp);
1954 } elsif ( $resp->type eq 'explain' ) {
1955 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1956 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1957 \%OpenILS::WWW::SuperCat::qualifier_ids
1961 print $cgi->header( -type => 'application/xml' );
1962 print $U->entityize($resp->asXML) . "\n";
1963 return Apache2::Const::OK;
1966 sub explain_header {
1969 my $host = $cgi->virtual_host || $cgi->server_name;
1972 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1973 my $rel_name = $cgi->url(-relative=>1);
1974 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1976 my $base = $cgi->url(-base=>1);
1977 my $url = $cgi->url(-path_info=>$add_path);
1978 $url =~ s/^$base\///o;
1980 my $doc = $parser->parse_string($base_explain);
1981 my $e = $doc->documentElement;
1982 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1983 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1984 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1989 sub return_sru_explain {
1990 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
1992 $index_map ||= \%qualifier_map;
1994 my ($doc, $e) = explain_header($cgi);
1995 for my $name ( keys %{$index_map} ) {
1997 my $identifier = $qualifier_ids->{ $name };
1999 next unless $identifier;
2001 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2002 $set_node->setAttribute( identifier => $identifier );
2003 $set_node->setAttribute( name => $name );
2005 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2006 for my $index ( sort keys %{$index_map->{$name}} ) {
2007 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2009 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2010 $map_node->appendChild( $name_node );
2012 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2014 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2015 $index_node->appendChild( $title_node );
2016 $index_node->appendChild( $map_node );
2018 $index_node->setAttribute( id => "$name.$index" );
2019 $title_node->appendText($index_map->{$name}{$index}{'title'});
2020 $name_node->setAttribute( set => $name );
2021 $name_node->appendText($index_map->{$name}{$index}{'index'});
2023 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2027 $$explain = $e->toString;
2031 SRU::Response::Record->new(
2032 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2033 recordData => $$explain
2039 sub return_auth_response {
2040 my ($cgi, $req, $resp) = @_;
2042 my $cql_query = decode_utf8($req->query);
2043 my $search = $req->cql->toEvergreenAuth;
2045 my $qualifier = decode_utf8($search->{qualifier});
2046 my $term = decode_utf8($search->{term});
2048 $log->info("SRU NAF search string [$cql_query] converted to "
2049 . "[$qualifier:$term]\n");
2051 my $page_size = $req->maximumRecords;
2054 # startwith deals with pages, so convert startRecord to a page number
2055 my $page = ($req->startRecord / $page_size) || 0;
2058 if ($qualifier eq "id") {
2059 $recs = [ int($term) ];
2061 $recs = $supercat->request(
2062 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2066 my $record_position = $req->startRecord;
2067 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2068 foreach my $record (@$recs) {
2069 my $marcxml = $cstore->request(
2070 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2074 SRU::Response::Record->new(
2075 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2076 recordData => $marcxml,
2077 recordPosition => ++$record_position
2082 $resp->numberOfRecords(scalar(@$recs));
2085 =head2 get_ou($org_unit)
2087 Returns an aou object for a given actor.org_unit shortname or ID.
2092 my $org = shift || '-';
2096 $org_unit = $actor->request(
2097 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2099 } elsif ($org !~ /^\d+$/o) {
2100 $org_unit = $actor->request(
2101 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2104 $org_unit = $actor->request(
2105 'open-ils.actor.org_unit_list.search' => id => $org