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";
685 # holdings_xml format comes back to us without an XML declaration
686 # and without being entityized; fix that here
687 if ($base_format eq 'holdings_xml') {
688 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
689 print $U->entityize($data);
691 while (my $c = $req->recv) {
692 print $U->entityize($c->content);
698 return Apache2::Const::OK;
704 return Apache2::Const::DECLINED if (-e $apache->filename);
709 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
710 my $rel_name = $cgi->url(-relative=>1);
711 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
714 my $url = $cgi->url(-path_info=>$add_path);
715 my $root = (split 'supercat', $url)[0];
716 my $base = (split 'supercat', $url)[0] . 'supercat';
717 my $unapi = (split 'supercat', $url)[0] . 'unapi';
719 my $host = $cgi->virtual_host || $cgi->server_name;
721 my $path = $cgi->path_info;
722 my ($id,$type,$format,$command) = reverse split '/', $path;
723 my $flesh_feed = parse_feed_type($format);
724 (my $base_format = $format) =~ s/(-full|-uris)$//o;
726 my $skin = $cgi->param('skin') || 'default';
727 my $locale = $cgi->param('locale') || 'en-US';
729 # Enable localized results of copy status, etc
730 $supercat->session_locale($locale);
732 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
733 print "Content-type: application/xml; charset=utf-8\n";
736 ->request("open-ils.supercat.$1.formats")
744 <type>text/html</type>
747 if ($1 eq 'record' or $1 eq 'isbn') {
749 <name>htmlholdings</name>
750 <type>text/html</type>
754 <type>text/html</type>
757 <name>htmlholdings-full</name>
758 <type>text/html</type>
761 <name>html-full</name>
762 <type>text/html</type>
766 <type>text/plain</type>
770 <type>text/plain</type>
775 my ($type) = keys %$h;
776 print supercat_format($h, $type);
778 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
779 print supercat_format($h, "$type-full");
780 print supercat_format($h, "$type-uris");
785 print "</formats>\n";
787 return Apache2::Const::OK;
791 ->request("open-ils.supercat.record.formats")
796 ->request("open-ils.supercat.metarecord.formats")
800 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
801 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
806 <type>text/html</type>
809 <name>htmlholdings</name>
810 <type>text/html</type>
814 <type>text/html</type>
817 <name>htmlholdings-full</name>
818 <type>text/html</type>
821 <name>html-full</name>
822 <type>text/html</type>
826 <type>text/plain</type>
830 <type>text/plain</type>
834 my ($type) = keys %$h;
835 print supercat_format($h, $type);
837 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
838 print supercat_format($h, "$type-full");
839 print supercat_format($h, "$type-uris");
844 print "</formats>\n";
847 return Apache2::Const::OK;
850 if ($format eq 'opac') {
851 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
852 if ($type eq 'metarecord');
853 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
854 if ($type eq 'record');
857 } elsif ($base_format eq 'marc21') {
861 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
863 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
868 # Escape user input before display
869 $id = CGI::escapeHTML($id);
871 print "Content-type: text/html; charset=utf-8\n\n";
872 $apache->custom_response( 404, <<" HTML");
879 <center>Couldn't fetch $id as MARC21.</center>
886 return Apache2::Const::OK;
888 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
889 my $feed = create_record_feed(
897 $feed->creator($host);
901 $feed->link( unapi => $base) if ($flesh_feed);
903 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
904 print $U->entityize($feed->toString) . "\n";
906 return Apache2::Const::OK;
909 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
913 # Escape user input before display
914 $command = CGI::escapeHTML($command);
915 $id = CGI::escapeHTML($id);
916 $type = CGI::escapeHTML($type);
917 $format = CGI::escapeHTML(decode_utf8($format));
919 print "Content-type: text/html; charset=utf-8\n\n";
920 $apache->custom_response( 404, <<" HTML");
923 <title>$type $id not found!</title>
927 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
934 print "Content-type: application/xml; charset=utf-8\n\n";
935 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
937 return Apache2::Const::OK;
943 return Apache2::Const::DECLINED if (-e $apache->filename);
947 my $year = (gmtime())[5] + 1900;
948 my $host = $cgi->virtual_host || $cgi->server_name;
951 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
952 my $rel_name = $cgi->url(-relative=>1);
953 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
956 my $url = $cgi->url(-path_info=>$add_path);
957 my $root = (split 'feed', $url)[0] . '/';
958 my $base = (split 'bookbag', $url)[0] . '/bookbag';
959 my $unapi = (split 'feed', $url)[0] . '/unapi';
961 my $skin = $cgi->param('skin') || 'default';
962 my $locale = $cgi->param('locale') || 'en-US';
963 my $org = $cgi->param('searchOrg');
965 # Enable localized results of copy status, etc
966 $supercat->session_locale($locale);
968 my $org_unit = get_ou($org);
969 my $scope = "l=" . $org_unit->[0]->id . "&";
971 $root =~ s{(?<!http:)//}{/}go;
972 $base =~ s{(?<!http:)//}{/}go;
973 $unapi =~ s{(?<!http:)//}{/}go;
975 my $path = $cgi->path_info;
976 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
978 my ($id,$type) = reverse split '/', $path;
979 my $flesh_feed = parse_feed_type($type);
981 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
982 return Apache2::Const::NOT_FOUND unless($bucket);
984 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
985 if ($type eq 'opac') {
986 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
987 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
992 my $feed = create_record_feed(
995 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
997 $org_unit->[0]->shortname,
1002 $feed->id($bucket_tag);
1004 $feed->title("Items in Book Bag [".$bucket->name."]");
1005 $feed->creator($host);
1008 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1009 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1010 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1011 $feed->link(unapi => $unapi);
1015 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1016 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1021 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1022 print $U->entityize($feed->toString) . "\n";
1024 return Apache2::Const::OK;
1029 return Apache2::Const::DECLINED if (-e $apache->filename);
1033 my $year = (gmtime())[5] + 1900;
1034 my $host = $cgi->virtual_host || $cgi->server_name;
1037 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1038 my $rel_name = $cgi->url(-relative=>1);
1039 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1042 my $url = $cgi->url(-path_info=>$add_path);
1043 my $root = (split 'feed', $url)[0];
1044 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1045 my $unapi = (split 'feed', $url)[0] . 'unapi';
1047 my $skin = $cgi->param('skin') || 'default';
1048 my $locale = $cgi->param('locale') || 'en-US';
1049 my $org = $cgi->param('searchOrg');
1051 # Enable localized results of copy status, etc
1052 $supercat->session_locale($locale);
1054 my $org_unit = get_ou($org);
1055 my $scope = "l=" . $org_unit->[0]->id . "&";
1057 my $path = $cgi->path_info;
1058 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1060 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1062 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1063 my $flesh_feed = parse_feed_type($type);
1066 $limit = 10 if $limit !~ /^\d+$/;
1068 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1070 #if ($type eq 'opac') {
1071 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1072 # join('&', map { "rl=" . $_ } @$list) .
1077 my $search = 'record';
1078 if ($rtype eq 'authority') {
1079 $search = 'authority';
1081 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1085 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1087 $feed->title("$limit most recent $rtype ${axis}s");
1090 $feed->creator($host);
1093 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1094 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1095 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1096 $feed->link(unapi => $unapi);
1100 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1101 join('&', map { 'rl=' . $_} @$list ),
1106 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1107 print $U->entityize($feed->toString) . "\n";
1109 return Apache2::Const::OK;
1112 sub opensearch_osd {
1113 my $version = shift;
1118 if ($version eq '1.0') {
1120 Content-type: application/opensearchdescription+xml; charset=utf-8
1122 <?xml version="1.0" encoding="UTF-8"?>
1123 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1124 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1125 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1126 <ShortName>$lib</ShortName>
1127 <LongName>Search $lib</LongName>
1128 <Description>Search the $lib OPAC by $class.</Description>
1129 <Tags>$lib book library</Tags>
1130 <SampleSearch>harry+potter</SampleSearch>
1131 <Developer>Mike Rylander for GPLS/PINES</Developer>
1132 <Contact>feedback\@open-ils.org</Contact>
1133 <SyndicationRight>open</SyndicationRight>
1134 <AdultContent>false</AdultContent>
1135 </OpenSearchDescription>
1139 Content-type: application/opensearchdescription+xml; charset=utf-8
1141 <?xml version="1.0" encoding="UTF-8"?>
1142 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1143 <ShortName>$lib</ShortName>
1144 <Description>Search the $lib OPAC by $class.</Description>
1145 <Tags>$lib book library</Tags>
1146 <Url type="application/rss+xml"
1147 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1148 <Url type="application/atom+xml"
1149 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1150 <Url type="application/x-mods3+xml"
1151 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1152 <Url type="application/x-mods+xml"
1153 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1154 <Url type="application/x-marcxml+xml"
1155 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1156 <Url type="text/html"
1157 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1158 <LongName>Search $lib</LongName>
1159 <Query role="example" searchTerms="harry+potter" />
1160 <Developer>Mike Rylander for GPLS/PINES</Developer>
1161 <Contact>feedback\@open-ils.org</Contact>
1162 <SyndicationRight>open</SyndicationRight>
1163 <AdultContent>false</AdultContent>
1164 <Language>en-US</Language>
1165 <OutputEncoding>UTF-8</OutputEncoding>
1166 <InputEncoding>UTF-8</InputEncoding>
1167 </OpenSearchDescription>
1171 return Apache2::Const::OK;
1174 sub opensearch_feed {
1176 return Apache2::Const::DECLINED if (-e $apache->filename);
1179 my $year = (gmtime())[5] + 1900;
1181 my $host = $cgi->virtual_host || $cgi->server_name;
1184 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1185 my $rel_name = $cgi->url(-relative=>1);
1186 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1189 my $url = $cgi->url(-path_info=>$add_path);
1190 my $root = (split 'opensearch', $url)[0];
1191 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1192 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1194 my $path = $cgi->path_info;
1195 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1197 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1203 if (!$lib || $lib eq '-') {
1204 $lib = $actor->request(
1205 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1206 )->gather(1)->[0]->shortname;
1209 if ($class eq '-') {
1213 return opensearch_osd($version, $lib, $class, $base);
1217 my $page = $cgi->param('startPage') || 1;
1218 my $offset = $cgi->param('startIndex') || 1;
1219 my $limit = $cgi->param('count') || 10;
1221 $page = 1 if ($page !~ /^\d+$/);
1222 $offset = 1 if ($offset !~ /^\d+$/);
1223 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1226 $offset = ($page - 1) * $limit;
1231 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1232 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1234 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1235 $lang = '' if ($lang eq '*');
1237 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1239 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1242 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1243 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1245 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1248 $type = $cgi->param('responseType') if $cgi->param('responseType');
1251 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1255 my $kwt = $cgi->param('kw');
1256 my $tit = $cgi->param('ti');
1257 my $aut = $cgi->param('au');
1258 my $sut = $cgi->param('su');
1259 my $set = $cgi->param('se');
1261 $terms .= " " if ($terms && $kwt);
1262 $terms .= "keyword: $kwt" if ($kwt);
1263 $terms .= " " if ($terms && $tit);
1264 $terms .= "title: $tit" if ($tit);
1265 $terms .= " " if ($terms && $aut);
1266 $terms .= "author: $aut" if ($aut);
1267 $terms .= " " if ($terms && $sut);
1268 $terms .= "subject: $sut" if ($sut);
1269 $terms .= " " if ($terms && $set);
1270 $terms .= "series: $set" if ($set);
1272 if ($version eq '1.0') {
1274 } elsif ($type eq '-') {
1277 my $flesh_feed = parse_feed_type($type);
1279 $terms = decode_utf8($terms);
1280 $lang = 'eng' if ($lang eq 'en-US');
1282 $log->debug("OpenSearch terms: $terms");
1284 my $org_unit = get_ou($org);
1286 # Apostrophes break search and get indexed as spaces anyway
1287 my $safe_terms = $terms;
1288 $safe_terms =~ s{'}{ }go;
1290 my $recs = $search->request(
1291 'open-ils.search.biblio.multiclass.query' => {
1292 org_unit => $org_unit->[0]->id,
1296 sort_dir => $sortdir,
1297 default_class => $class,
1298 ($lang ? ( 'language' => $lang ) : ()),
1299 } => $safe_terms => 1
1302 $log->debug("Hits for [$terms]: $recs->{count}");
1304 my $feed = create_record_feed(
1307 [ map { $_->[0] } @{$recs->{ids}} ],
1314 $log->debug("Feed created...");
1318 $feed->search($safe_terms);
1319 $feed->class($class);
1321 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1323 $feed->creator($host);
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 $feed->_create_node(
1341 $feed->{item_xpath},
1342 'http://a9.com/-/spec/opensearch/1.1/',
1347 $log->debug("...basic feed data added...");
1351 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1352 'application/opensearch+xml'
1353 ) if ($offset + $limit < $recs->{count});
1357 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1358 'application/opensearch+xml'
1363 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1364 'application/opensearch+xml'
1369 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1370 'application/rss+xml'
1375 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1376 'application/atom+xml'
1381 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1387 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1391 $feed->link( 'unapi-server' => $unapi);
1393 $log->debug("...feed links added...");
1397 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1398 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1402 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1403 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1405 $log->debug("...and feed returned.");
1407 return Apache2::Const::OK;
1410 sub create_record_feed {
1413 my $records = shift;
1416 my $lib = uc(shift()) || '-';
1423 my $base = $cgi->url;
1424 my $host = $cgi->virtual_host || $cgi->server_name;
1426 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1430 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1432 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1434 $type =~ s/(-full|-uris)$//o;
1436 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1437 $feed->base($base) if ($flesh);
1438 $feed->unapi($unapi) if ($flesh);
1440 $type = 'atom' if ($type eq 'html');
1441 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1443 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1446 for my $record (@$records) {
1447 next unless($record);
1449 #my $rec = $record->id;
1452 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1453 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1454 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1455 $item_tag .= "/$depth" if (defined($depth));
1457 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1459 my $xml = $supercat->request(
1460 "open-ils.supercat.$search.$type.retrieve",
1465 my $node = $feed->add_item($xml);
1469 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0 || $flesh eq 'uris')) {
1470 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1471 while ( !$r->complete ) {
1472 $xml .= join('', map {$_->content} $r->recv);
1474 $xml .= join('', map {$_->content} $r->recv);
1475 $node->add_holdings($xml);
1478 $node->id($item_tag);
1479 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1480 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0 || $flesh eq 'uris');
1481 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0 || $flesh eq 'uris');
1482 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1483 $node->link('unapi-id' => $item_tag) if ($flesh);
1491 return Apache2::Const::DECLINED if (-e $apache->filename);
1494 my $year = (gmtime())[5] + 1900;
1496 my $host = $cgi->virtual_host || $cgi->server_name;
1499 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1500 my $rel_name = $cgi->url(-relative=>1);
1501 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1504 my $url = $cgi->url(-path_info=>$add_path);
1505 my $root = (split 'browse', $url)[0];
1506 my $base = (split 'browse', $url)[0] . 'browse';
1507 my $unapi = (split 'browse', $url)[0] . 'unapi';
1509 my $path = $cgi->path_info;
1512 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1513 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1515 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1517 my $status = [$cgi->param('status')];
1518 my $cpLoc = [$cgi->param('copyLocation')];
1519 $site ||= $cgi->param('searchOrg');
1520 $page ||= $cgi->param('startPage') || 0;
1521 $page_size ||= $cgi->param('count') || 9;
1523 $page = 0 if ($page !~ /^-?\d+$/);
1524 $page_size = 9 if $page_size !~ /^\d+$/;
1526 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1527 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1529 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1530 warn "something's wrong...";
1531 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1535 $string = decode_utf8($string);
1536 $string =~ s/\+/ /go;
1539 my $tree = $supercat->request(
1540 "open-ils.supercat.$axis.browse",
1542 (($axis =~ /^authority/) ? () : ($site)),
1549 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1551 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1552 print $header.$content;
1553 return Apache2::Const::OK;
1556 sub string_startwith {
1558 return Apache2::Const::DECLINED if (-e $apache->filename);
1561 my $year = (gmtime())[5] + 1900;
1563 my $host = $cgi->virtual_host || $cgi->server_name;
1566 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1567 my $rel_name = $cgi->url(-relative=>1);
1568 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1571 my $url = $cgi->url(-path_info=>$add_path);
1572 my $root = (split 'startwith', $url)[0];
1573 my $base = (split 'startwith', $url)[0] . 'startwith';
1574 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1576 my $path = $cgi->path_info;
1579 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1580 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1582 my $status = [$cgi->param('status')];
1583 my $cpLoc = [$cgi->param('copyLocation')];
1584 $site ||= $cgi->param('searchOrg');
1585 $page ||= $cgi->param('startPage') || 0;
1586 $page_size ||= $cgi->param('count') || 9;
1588 $page = 0 if ($page !~ /^-?\d+$/);
1589 $page_size = 9 if $page_size !~ /^\d+$/;
1591 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1592 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1594 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1595 warn "something's wrong...";
1596 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1600 $string = decode_utf8($string);
1601 $string =~ s/\+/ /go;
1604 my $tree = $supercat->request(
1605 "open-ils.supercat.$axis.startwith",
1607 (($axis =~ /^authority/) ? () : ($site)),
1614 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1616 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1617 print $header.$content;
1618 return Apache2::Const::OK;
1621 sub item_age_browse {
1623 return Apache2::Const::DECLINED if (-e $apache->filename);
1626 my $year = (gmtime())[5] + 1900;
1628 my $host = $cgi->virtual_host || $cgi->server_name;
1631 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1632 my $rel_name = $cgi->url(-relative=>1);
1633 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1636 my $url = $cgi->url(-path_info=>$add_path);
1637 my $root = (split 'browse', $url)[0];
1638 my $base = (split 'browse', $url)[0] . 'browse';
1639 my $unapi = (split 'browse', $url)[0] . 'unapi';
1641 my $path = $cgi->path_info;
1644 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1645 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1647 unless ($axis eq 'item-age') {
1648 warn "something's wrong...";
1649 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1653 my $status = [$cgi->param('status')];
1654 my $cpLoc = [$cgi->param('copyLocation')];
1655 $site ||= $cgi->param('searchOrg') || '-';
1656 $page ||= $cgi->param('startPage') || 1;
1657 $page_size ||= $cgi->param('count') || 10;
1659 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1660 $page_size = 10 if $page_size !~ /^\d+$/;
1662 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1663 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1665 my $recs = $supercat->request(
1666 "open-ils.supercat.new_book_list",
1674 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1676 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1677 print $header.$content;
1678 return Apache2::Const::OK;
1681 our %qualifier_ids = (
1682 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1683 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1684 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1688 # Our authority search options are currently pretty impoverished;
1689 # just right-truncated string match on a few categories, or by
1691 our %nested_auth_qualifier_map = (
1693 id => { index => 'id', title => 'Record number'},
1694 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1695 title => { index => 'title', title => 'Uniform title'},
1696 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1697 topic => { index => 'topic', title => 'Topical term'},
1701 my $base_explain = <<XML;
1703 id="evergreen-sru-explain-full"
1704 authoritative="true"
1705 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1706 xmlns="http://explain.z3950.org/dtd/2.0/">
1707 <serverInfo transport="http" protocol="SRU" version="1.1">
1714 <title primary="true"/>
1715 <description primary="true"/>
1719 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1724 identifier="info:srw/schema/1/marcxml-v1.1"
1725 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1729 <title>MARC21Slim (marcxml)</title>
1734 <default type="numberOfRecords">10</default>
1735 <default type="contextSet">eg</default>
1736 <default type="index">keyword</default>
1737 <default type="relation">all</default>
1738 <default type="sortSchema">marcxml</default>
1739 <default type="retrieveSchema">marcxml</default>
1740 <setting type="maximumRecords">50</setting>
1741 <supports type="relationModifier">relevant</supports>
1742 <supports type="relationModifier">stem</supports>
1743 <supports type="relationModifier">fuzzy</supports>
1744 <supports type="relationModifier">word</supports>
1755 my $req = SRU::Request->newFromCGI( $cgi );
1756 my $resp = SRU::Response->newFromRequest( $req );
1758 # Find the org_unit shortname, if passed as part of the URL
1759 # http://example.com/opac/extras/sru/SHORTNAME
1760 my $url = $cgi->path_info;
1761 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1763 if ( $resp->type eq 'searchRetrieve' ) {
1765 # Older versions of Debian packages returned terms to us double-encoded,
1766 # so we had to forcefully double-decode them a second time with
1767 # an outer decode('utf8', $string) call; this seems to be resolved with
1768 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1769 my $cql_query = decode_utf8($req->query);
1770 my $search_string = decode_utf8($req->cql->toEvergreen);
1772 # Ensure the search string overrides the default site
1773 if ($shortname and $search_string !~ m#site:#) {
1774 $search_string .= " site:$shortname";
1777 my $offset = $req->startRecord;
1778 $offset-- if ($offset);
1781 my $limit = $req->maximumRecords;
1784 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1786 my $recs = $search->request(
1787 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1790 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1792 foreach my $record (@$bre) {
1793 my $marcxml = $record->marc;
1794 # Make the beast conform to a VDX-supported format
1795 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1796 # Trying to implement LIBSOL_852_A format; so much for standards
1798 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1799 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1801 # Force record leader to 'a' as our data is always UTF8
1802 # Avoids marc8_to_utf8 from being invoked with horrible results
1803 # on the off-chance the record leader isn't correct
1804 my $ldr = $marc->leader;
1805 substr($ldr, 9, 1, 'a');
1806 $marc->leader($ldr);
1808 # Expects the record ID in the 001
1809 $marc->delete_field($_) for ($marc->field('001'));
1810 if (!$marc->field('001')) {
1811 $marc->insert_fields_ordered(
1812 MARC::Field->new( '001', $record->id )
1815 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1816 foreach my $cn (keys %$bib_holdings) {
1817 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1818 $marc->insert_fields_ordered(
1821 a => $cp->{'location'},
1822 b => $bib_holdings->{$cn}->{'owning_lib'},
1824 d => $cp->{'circlib'},
1825 g => $cp->{'barcode'},
1826 n => $cp->{'status'},
1832 # Ensure the data is encoded as UTF8 before we hand it off
1833 $marcxml = encode_utf8($marc->as_xml_record());
1834 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1838 SRU::Response::Record->new(
1839 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1840 recordData => $marcxml,
1841 recordPosition => ++$offset
1846 $resp->numberOfRecords($recs->{count});
1848 } elsif ( $resp->type eq 'explain' ) {
1849 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1851 \%OpenILS::WWW::SuperCat::qualifier_ids
1855 SRU::Response::Record->new(
1856 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1857 recordData => $ex_doc
1862 print $cgi->header( -type => 'application/xml' );
1863 print $U->entityize($resp->asXML) . "\n";
1864 return Apache2::Const::OK;
1869 package CQL::BooleanNode;
1873 my $left = $self->left();
1874 my $right = $self->right();
1875 my $leftStr = $left->toEvergreen;
1876 my $rightStr = $right->toEvergreen();
1878 my $op = '||' if uc $self->op() eq 'OR';
1881 return "$leftStr $rightStr";
1884 sub toEvergreenAuth {
1885 return toEvergreen(shift);
1888 package CQL::TermNode;
1892 my $qualifier = $self->getQualifier();
1893 my $term = $self->getTerm();
1894 my $relation = $self->getRelation();
1898 my ($qset, $qname) = split(/\./, $qualifier);
1900 if ( exists($qualifier_map{$qset}{$qname}) ) {
1901 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1902 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1905 my @modifiers = $relation->getModifiers();
1907 my $base = $relation->getBase();
1908 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1911 foreach my $m ( @modifiers ) {
1912 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1918 $quote_it = 0 if ( $base eq 'all' );
1919 $term = maybeQuote($term) if $quote_it;
1922 croak( "Evergreen doesn't support the $base relations" );
1930 return "$qualifier:$term";
1933 sub toEvergreenAuth {
1935 my $qualifier = $self->getQualifier();
1936 my $term = $self->getTerm();
1937 my $relation = $self->getRelation();
1941 my ($qset, $qname) = split(/\./, $qualifier);
1943 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1944 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1945 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1948 return { qualifier => $qualifier, term => $term };
1953 sub sru_auth_search {
1956 my $req = SRU::Request->newFromCGI( $cgi );
1957 my $resp = SRU::Response->newFromRequest( $req );
1959 if ( $resp->type eq 'searchRetrieve' ) {
1960 return_auth_response($cgi, $req, $resp);
1961 } elsif ( $resp->type eq 'explain' ) {
1962 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1963 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1964 \%OpenILS::WWW::SuperCat::qualifier_ids
1968 print $cgi->header( -type => 'application/xml' );
1969 print $U->entityize($resp->asXML) . "\n";
1970 return Apache2::Const::OK;
1973 sub explain_header {
1976 my $host = $cgi->virtual_host || $cgi->server_name;
1979 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1980 my $rel_name = $cgi->url(-relative=>1);
1981 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1983 my $base = $cgi->url(-base=>1);
1984 my $url = $cgi->url(-path_info=>$add_path);
1985 $url =~ s/^$base\///o;
1987 my $doc = $parser->parse_string($base_explain);
1988 my $e = $doc->documentElement;
1989 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1990 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1991 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1996 sub return_sru_explain {
1997 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
1999 $index_map ||= \%qualifier_map;
2001 my ($doc, $e) = explain_header($cgi);
2002 for my $name ( keys %{$index_map} ) {
2004 my $identifier = $qualifier_ids->{ $name };
2006 next unless $identifier;
2008 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2009 $set_node->setAttribute( identifier => $identifier );
2010 $set_node->setAttribute( name => $name );
2012 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2013 for my $index ( sort keys %{$index_map->{$name}} ) {
2014 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2016 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2017 $map_node->appendChild( $name_node );
2019 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2021 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2022 $index_node->appendChild( $title_node );
2023 $index_node->appendChild( $map_node );
2025 $index_node->setAttribute( id => "$name.$index" );
2026 $title_node->appendText($index_map->{$name}{$index}{'title'});
2027 $name_node->setAttribute( set => $name );
2028 $name_node->appendText($index_map->{$name}{$index}{'index'});
2030 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2034 $$explain = $e->toString;
2038 SRU::Response::Record->new(
2039 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2040 recordData => $$explain
2046 sub return_auth_response {
2047 my ($cgi, $req, $resp) = @_;
2049 my $cql_query = decode_utf8($req->query);
2050 my $search = $req->cql->toEvergreenAuth;
2052 my $qualifier = decode_utf8($search->{qualifier});
2053 my $term = decode_utf8($search->{term});
2055 $log->info("SRU NAF search string [$cql_query] converted to "
2056 . "[$qualifier:$term]\n");
2058 my $page_size = $req->maximumRecords;
2061 # startwith deals with pages, so convert startRecord to a page number
2062 my $page = ($req->startRecord / $page_size) || 0;
2065 if ($qualifier eq "id") {
2066 $recs = [ int($term) ];
2068 $recs = $supercat->request(
2069 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2073 my $record_position = $req->startRecord;
2074 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2075 foreach my $record (@$recs) {
2076 my $marcxml = $cstore->request(
2077 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2081 SRU::Response::Record->new(
2082 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2083 recordData => $marcxml,
2084 recordPosition => ++$record_position
2089 $resp->numberOfRecords(scalar(@$recs));
2092 =head2 get_ou($org_unit)
2094 Returns an aou object for a given actor.org_unit shortname or ID.
2099 my $org = shift || '-';
2103 $org_unit = $actor->request(
2104 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2106 } elsif ($org !~ /^\d+$/o) {
2107 $org_unit = $actor->request(
2108 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2111 $org_unit = $actor->request(
2112 'open-ils.actor.org_unit_list.search' => id => $org