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;
31 use MARC::File::XML ( BinaryEncoding => 'UTF-8' );
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;
54 my $cn_prefix = $cn->prefix->label;
55 my $cn_suffix = $cn->suffix->label;
57 $cn_label =~ s/\n//gos;
58 $cn_label =~ s/&/&/go;
59 $cn_label =~ s/'/'/go;
60 $cn_label =~ s/</</go;
61 $cn_label =~ s/>/>/go;
63 $cn_prefix =~ s/\n//gos;
64 $cn_prefix =~ s/&/&/go;
65 $cn_prefix =~ s/'/'/go;
66 $cn_prefix =~ s/</</go;
67 $cn_prefix =~ s/>/>/go;
69 $cn_suffix =~ s/\n//gos;
70 $cn_suffix =~ s/&/&/go;
71 $cn_suffix =~ s/'/'/go;
72 $cn_suffix =~ s/</</go;
73 $cn_suffix =~ s/>/>/go;
75 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
76 $ou_class =~ s/Fieldmapper-//gso;
78 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
79 my $ou_name = $cn->owning_lib->name;
81 $ou_name =~ s/\n//gos;
82 $ou_name =~ s/'/'/go;
84 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
85 $rec_class =~ s/Fieldmapper-//gso;
87 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
89 $content .= "<volume id='$cn_tag' lib='$cn_lib' prefix='$cn_prefix' label='$cn_label' suffix='$cn_suffix'>\n";
90 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
92 my $r_doc = $parser->parse_string($cn->record->marc);
93 $r_doc->documentElement->setAttribute( id => $rec_tag );
94 $content .= $U->entityize($r_doc->documentElement->toString);
96 $content .= "</volume>\n";
99 $content .= "</volumes>\n";
100 return ("Content-type: application/xml\n\n",$content);
104 $browse_types{call_number}{html} = sub {
109 if (!$cn_browse_xslt) {
110 $cn_browse_xslt = $parser->parse_file(
111 OpenSRF::Utils::SettingsClient
113 ->config_value( dirs => 'xsl' ).
116 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
119 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
122 "Content-type: text/html\n\n",
124 $cn_browse_xslt->transform(
125 $parser->parse_string( $xml ),
140 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
142 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
143 Fieldmapper->import(IDL => $idl);
145 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
146 $actor = OpenSRF::AppSession->create('open-ils.actor');
147 $search = OpenSRF::AppSession->create('open-ils.search');
148 $parser = new XML::LibXML;
149 $xslt = new XML::LibXSLT;
151 $cn_browse_xslt = $parser->parse_file(
152 OpenSRF::Utils::SettingsClient
154 ->config_value( dirs => 'xsl' ).
158 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
160 %qualifier_map = %{$supercat
161 ->request("open-ils.supercat.biblio.search_aliases")
164 my %attribute_desc = (
165 site => 'Evergreen Site Code (shortname)',
166 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
167 dir => 'Sort direction (asc|desc)',
168 available => 'Filter to available (true|false)',
171 # Append the non-search-alias attributes to the qualifier map
188 preferred_language_weight
189 preferred_language_multiplier
191 $qualifier_map{'eg'}{$_}{'index'} = $_;
192 if (exists $attribute_desc{$_}) {
193 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
195 $qualifier_map{'eg'}{$_}{'title'} = $_;
200 ->request("open-ils.supercat.record.formats")
203 $list = [ map { (keys %$_)[0] } @$list ];
204 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
206 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
207 for my $record_browse_format ( @$list ) {
209 my $__f = $record_browse_format;
210 my $__a = $browse_axis;
212 $browse_types{$__a}{$__f} = sub {
213 my $record_list = shift;
216 my $real_format = shift || $__f;
221 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
222 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
223 $feed->root( "$base/../" );
225 $feed->link( next => $next => $feed->type );
226 $feed->link( previous => $prev => $feed->type );
229 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
237 for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
238 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
241 my $__a = $browse_axis;
243 $browse_types{$__a}{$__f} = sub {
244 my $record_list = shift;
247 my $real_format = shift || $__f;
252 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
253 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
254 $feed->root( "$base/../" );
255 $feed->link( next => $next => $feed->type );
256 $feed->link( previous => $prev => $feed->type );
259 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
268 =head2 parse_feed_type($type)
270 Determines whether and how a given feed type needs to be "fleshed out"
271 with holdings information.
273 The feed type could end with the string "-full", in which case we want
274 to return call numbers, copies, and URIS.
276 Or the feed type could end with "-uris", in which case we want to return
277 call numbers and URIS.
279 Otherwise, we won't return any holdings.
283 sub parse_feed_type {
286 if ($type =~ /-full$/o) {
290 if ($type =~ /-uris$/o) {
294 # Otherwise, we'll return just the facts, ma'am
298 =head2 supercat_format($format_hashref, $format_type)
300 Given a reference to a hash containing the namespace_uri,
301 docs, and schema location attributes for a set of formats,
302 generate the XML description required by the supercat service.
304 We derive the base type from the format type so that we do not
305 have to populate the hash with redundant information.
309 sub supercat_format {
313 (my $base_type = $type) =~ s/(-full|-uris)$//o;
315 my $format = "<format><name>$type</name><type>application/xml</type>";
317 for my $part ( qw/namespace_uri docs schema_location/ ) {
318 $format .= "<$part>$$h{$base_type}{$part}</$part>"
319 if ($$h{$base_type}{$part});
322 $format .= '</format>';
327 =head2 unapi_format($format_hashref, $format_type)
329 Given a reference to a hash containing the namespace_uri,
330 docs, and schema location attributes for a set of formats,
331 generate the XML description required by the supercat service.
333 We derive the base type from the format type so that we do not
334 have to populate the hash with redundant information.
342 (my $base_type = $type) =~ s/(-full|-uris)$//o;
344 my $format = "<format name='$type' type='application/xml'";
346 for my $part ( qw/namespace_uri docs schema_location/ ) {
347 $format .= " $part='$$h{$base_type}{$part}'"
348 if ($$h{$base_type}{$part});
360 return Apache2::Const::DECLINED if (-e $apache->filename);
362 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
365 ->request("open-ils.supercat.oisbn", $isbn)
368 print "Content-type: application/xml; charset=utf-8\n\n";
369 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
371 unless (exists $$list{metarecord}) {
373 return Apache2::Const::OK;
376 print "<idlist metarecord='$$list{metarecord}'>\n";
378 for ( keys %{ $$list{record_list} } ) {
379 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
380 print " <isbn record='$_'>$o</isbn>\n"
385 return Apache2::Const::OK;
391 return Apache2::Const::DECLINED if (-e $apache->filename);
396 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
397 my $rel_name = $cgi->url(-relative=>1);
398 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
401 my $url = $cgi->url(-path_info=>$add_path);
402 my $root = (split 'unapi', $url)[0];
403 my $base = (split 'unapi', $url)[0] . 'unapi';
406 my $uri = $cgi->param('id') || '';
407 my $host = $cgi->virtual_host || $cgi->server_name;
409 my $skin = $cgi->param('skin') || 'default';
410 my $locale = $cgi->param('locale') || 'en-US';
412 # Enable localized results of copy status, etc
413 $supercat->session_locale($locale);
415 my $format = $cgi->param('format');
416 my $flesh_feed = parse_feed_type($format);
417 (my $base_format = $format) =~ s/(-full|-uris)$//o;
418 my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
421 my $body = "Content-type: application/xml; charset=utf-8\n\n";
423 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
426 ($lib,$depth) = split('/', $4);
428 $type = 'metarecord' if ($1 =~ /^m/o);
429 $type = 'authority' if ($1 =~ /^authority/o);
432 ->request("open-ils.supercat.$type.formats")
435 if ($type eq 'record' or $type eq 'isbn') {
436 $body .= <<" FORMATS";
438 <format name='opac' type='text/html'/>
439 <format name='html' type='text/html'/>
440 <format name='htmlholdings' type='text/html'/>
441 <format name='holdings_xml' type='application/xml'/>
442 <format name='holdings_xml-full' type='application/xml'/>
443 <format name='html-full' type='text/html'/>
444 <format name='htmlholdings-full' type='text/html'/>
445 <format name='marctxt' type='text/plain'/>
446 <format name='ris' type='text/plain'/>
448 } elsif ($type eq 'metarecord') {
449 $body .= <<" FORMATS";
451 <format name='opac' type='text/html'/>
454 $body .= <<" FORMATS";
460 my ($type) = keys %$h;
461 $body .= unapi_format($h, $type);
463 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
464 $body .= unapi_format($h, "$type-full");
465 $body .= unapi_format($h, "$type-uris");
469 $body .= "</formats>\n";
473 ->request("open-ils.supercat.$type.formats")
478 ->request("open-ils.supercat.metarecord.formats")
482 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
483 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
485 $body .= <<" FORMATS";
487 <format name='opac' type='text/html'/>
488 <format name='html' type='text/html'/>
489 <format name='htmlholdings' type='text/html'/>
490 <format name='holdings_xml' type='application/xml'/>
491 <format name='holdings_xml-full' type='application/xml'/>
492 <format name='html-full' type='text/html'/>
493 <format name='htmlholdings-full' type='text/html'/>
494 <format name='marctxt' type='text/plain'/>
495 <format name='ris' type='text/plain'/>
500 my ($type) = keys %$h;
501 $body .= "\t" . unapi_format($h, $type);
503 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
504 $body .= "\t" . unapi_format($h, "$type-full");
505 $body .= "\t" . unapi_format($h, "$type-uris");
509 $body .= "</formats>\n";
513 return Apache2::Const::OK;
517 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
521 ($lib,$depth) = split('/', $4);
523 $type = 'metarecord' if ($scheme =~ /^metabib/o);
524 $type = 'isbn' if ($scheme =~ /^isbn/o);
525 $type = 'acp' if ($scheme =~ /^asset-copy/o);
526 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
527 $type = 'auri' if ($scheme =~ /^asset-uri/o);
528 $type = 'authority' if ($scheme =~ /^authority/o);
529 $command = 'retrieve';
530 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
534 $paging = [split ',', $paging];
539 if (!$lib || $lib eq '-') {
540 $lib = $actor->request(
541 'open-ils.actor.org_unit_list.search' => parent_ou => undef
542 )->gather(1)->[0]->shortname;
545 my ($lib_object,$lib_id,$ou_types,$lib_depth);
546 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
547 $lib_object = $actor->request(
548 'open-ils.actor.org_unit_list.search' => shortname => $lib
550 $lib_id = $lib_object->id;
552 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
553 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
556 if ($command eq 'browse') {
557 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
561 if ($type eq 'isbn') {
562 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
564 # Escape user input before display
565 $command = CGI::escapeHTML($command);
566 $id = CGI::escapeHTML($id);
567 $type = CGI::escapeHTML($type);
568 $format = CGI::escapeHTML(decode_utf8($format));
570 print "Content-type: text/html; charset=utf-8\n\n";
571 $apache->custom_response( 404, <<" HTML");
574 <title>Type [$type] with id [$id] not found!</title>
578 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
589 { (keys(%$_))[0] eq $base_format }
590 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
592 { $_ eq $base_format }
593 qw/opac html htmlholdings marctxt ris holdings_xml/
595 # Escape user input before display
596 $format = CGI::escapeHTML($format);
597 $type = CGI::escapeHTML($type);
599 print "Content-type: text/html; charset=utf-8\n\n";
600 $apache->custom_response( 406, <<" HTML");
603 <title>Invalid format [$format] for type [$type]!</title>
607 <center>Sorry, format $format is not valid for type $type.</center>
614 if ($format eq 'opac') {
615 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
616 if ($type eq 'metarecord');
617 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
618 if ($type eq 'record');
620 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
621 my $feed = create_record_feed(
632 # Escape user input before display
633 $command = CGI::escapeHTML($command);
634 $id = CGI::escapeHTML($id);
635 $type = CGI::escapeHTML($type);
636 $format = CGI::escapeHTML(decode_utf8($format));
638 print "Content-type: text/html; charset=utf-8\n\n";
639 $apache->custom_response( 404, <<" HTML");
642 <title>Type [$type] with id [$id] not found!</title>
646 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
654 $feed->creator($host);
656 $feed->link( unapi => $base) if ($flesh_feed);
658 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
659 print $U->entityize($feed->toString) . "\n";
661 return Apache2::Const::OK;
664 my $method = "open-ils.supercat.$type.$base_format.$command";
666 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
668 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
669 # however, we can have it carry extra options like no_record! (comma separated)
670 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
672 my $req = $supercat->request($method,@params);
673 my $data = $req->gather();
675 if ($req->failed || !$data) {
676 # Escape user input before display
677 $command = CGI::escapeHTML($command);
678 $id = CGI::escapeHTML($id);
679 $type = CGI::escapeHTML($type);
680 $format = CGI::escapeHTML(decode_utf8($format));
682 print "Content-type: text/html; charset=utf-8\n\n";
683 $apache->custom_response( 404, <<" HTML");
686 <title>$type $id not found!</title>
690 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
697 print "Content-type: application/xml; charset=utf-8\n\n";
699 # holdings_xml format comes back to us without an XML declaration
700 # and without being entityized; fix that here
701 if ($base_format eq 'holdings_xml') {
702 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
703 print $U->entityize($data);
705 while (my $c = $req->recv) {
706 print $U->entityize($c->content);
712 return Apache2::Const::OK;
718 return Apache2::Const::DECLINED if (-e $apache->filename);
723 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
724 my $rel_name = $cgi->url(-relative=>1);
725 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
728 my $url = $cgi->url(-path_info=>$add_path);
729 my $root = (split 'supercat', $url)[0];
730 my $base = (split 'supercat', $url)[0] . 'supercat';
731 my $unapi = (split 'supercat', $url)[0] . 'unapi';
733 my $host = $cgi->virtual_host || $cgi->server_name;
735 my $path = $cgi->path_info;
736 my ($id,$type,$format,$command) = reverse split '/', $path;
737 my $flesh_feed = parse_feed_type($format);
738 (my $base_format = $format) =~ s/(-full|-uris)$//o;
740 my $skin = $cgi->param('skin') || 'default';
741 my $locale = $cgi->param('locale') || 'en-US';
743 # Enable localized results of copy status, etc
744 $supercat->session_locale($locale);
746 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
747 print "Content-type: application/xml; charset=utf-8\n";
750 ->request("open-ils.supercat.$1.formats")
758 <type>text/html</type>
761 if ($1 eq 'record' or $1 eq 'isbn') {
763 <name>htmlholdings</name>
764 <type>text/html</type>
768 <type>text/html</type>
771 <name>htmlholdings-full</name>
772 <type>text/html</type>
775 <name>html-full</name>
776 <type>text/html</type>
780 <type>text/plain</type>
784 <type>text/plain</type>
789 my ($type) = keys %$h;
790 print supercat_format($h, $type);
792 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
793 print supercat_format($h, "$type-full");
794 print supercat_format($h, "$type-uris");
799 print "</formats>\n";
801 return Apache2::Const::OK;
805 ->request("open-ils.supercat.record.formats")
810 ->request("open-ils.supercat.metarecord.formats")
814 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
815 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
820 <type>text/html</type>
823 <name>htmlholdings</name>
824 <type>text/html</type>
828 <type>text/html</type>
831 <name>htmlholdings-full</name>
832 <type>text/html</type>
835 <name>html-full</name>
836 <type>text/html</type>
840 <type>text/plain</type>
844 <type>text/plain</type>
848 my ($type) = keys %$h;
849 print supercat_format($h, $type);
851 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
852 print supercat_format($h, "$type-full");
853 print supercat_format($h, "$type-uris");
858 print "</formats>\n";
861 return Apache2::Const::OK;
864 if ($format eq 'opac') {
865 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
866 if ($type eq 'metarecord');
867 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
868 if ($type eq 'record');
871 } elsif ($base_format eq 'marc21') {
875 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
877 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
882 # Escape user input before display
883 $id = CGI::escapeHTML($id);
885 print "Content-type: text/html; charset=utf-8\n\n";
886 $apache->custom_response( 404, <<" HTML");
893 <center>Couldn't fetch $id as MARC21.</center>
900 return Apache2::Const::OK;
902 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
903 my $feed = create_record_feed(
911 $feed->creator($host);
915 $feed->link( unapi => $base) if ($flesh_feed);
917 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
918 print $U->entityize($feed->toString) . "\n";
920 return Apache2::Const::OK;
923 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
927 # Escape user input before display
928 $command = CGI::escapeHTML($command);
929 $id = CGI::escapeHTML($id);
930 $type = CGI::escapeHTML($type);
931 $format = CGI::escapeHTML(decode_utf8($format));
933 print "Content-type: text/html; charset=utf-8\n\n";
934 $apache->custom_response( 404, <<" HTML");
937 <title>$type $id not found!</title>
941 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
948 print "Content-type: application/xml; charset=utf-8\n\n";
949 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
951 return Apache2::Const::OK;
957 return Apache2::Const::DECLINED if (-e $apache->filename);
961 my $year = (gmtime())[5] + 1900;
962 my $host = $cgi->virtual_host || $cgi->server_name;
965 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
966 my $rel_name = $cgi->url(-relative=>1);
967 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
970 my $url = $cgi->url(-path_info=>$add_path);
971 my $root = (split 'feed', $url)[0] . '/';
972 my $base = (split 'bookbag', $url)[0] . '/bookbag';
973 my $unapi = (split 'feed', $url)[0] . '/unapi';
975 my $skin = $cgi->param('skin') || 'default';
976 my $locale = $cgi->param('locale') || 'en-US';
977 my $org = $cgi->param('searchOrg');
979 # Enable localized results of copy status, etc
980 $supercat->session_locale($locale);
982 my $org_unit = get_ou($org);
983 my $scope = "l=" . $org_unit->[0]->id . "&";
985 $root =~ s{(?<!http:)//}{/}go;
986 $base =~ s{(?<!http:)//}{/}go;
987 $unapi =~ s{(?<!http:)//}{/}go;
989 my $path = $cgi->path_info;
990 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
992 my ($id,$type) = reverse split '/', $path;
993 my $flesh_feed = parse_feed_type($type);
995 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
996 return Apache2::Const::NOT_FOUND unless($bucket);
998 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
999 if ($type eq 'opac') {
1000 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1001 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
1006 my $feed = create_record_feed(
1009 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
1011 $org_unit->[0]->shortname,
1016 $feed->id($bucket_tag);
1018 $feed->title("Items in Book Bag [".$bucket->name."]");
1019 $feed->creator($host);
1022 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1023 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1024 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1025 $feed->link(unapi => $unapi);
1029 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1030 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1035 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1036 print $U->entityize($feed->toString) . "\n";
1038 return Apache2::Const::OK;
1043 return Apache2::Const::DECLINED if (-e $apache->filename);
1047 my $year = (gmtime())[5] + 1900;
1048 my $host = $cgi->virtual_host || $cgi->server_name;
1051 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1052 my $rel_name = $cgi->url(-relative=>1);
1053 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1056 my $url = $cgi->url(-path_info=>$add_path);
1057 my $root = (split 'feed', $url)[0];
1058 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1059 my $unapi = (split 'feed', $url)[0] . 'unapi';
1061 my $skin = $cgi->param('skin') || 'default';
1062 my $locale = $cgi->param('locale') || 'en-US';
1063 my $org = $cgi->param('searchOrg');
1065 # Enable localized results of copy status, etc
1066 $supercat->session_locale($locale);
1068 my $org_unit = get_ou($org);
1069 my $scope = "l=" . $org_unit->[0]->id . "&";
1071 my $path = $cgi->path_info;
1072 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1074 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1076 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1077 my $flesh_feed = parse_feed_type($type);
1080 $limit = 10 if $limit !~ /^\d+$/;
1082 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1084 #if ($type eq 'opac') {
1085 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1086 # join('&', map { "rl=" . $_ } @$list) .
1091 my $search = 'record';
1092 if ($rtype eq 'authority') {
1093 $search = 'authority';
1095 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1099 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1101 $feed->title("$limit most recent $rtype ${axis}s");
1104 $feed->creator($host);
1107 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1108 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1109 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1110 $feed->link(unapi => $unapi);
1114 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1115 join('&', map { 'rl=' . $_} @$list ),
1120 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1121 print $U->entityize($feed->toString) . "\n";
1123 return Apache2::Const::OK;
1126 sub opensearch_osd {
1127 my $version = shift;
1132 if ($version eq '1.0') {
1134 Content-type: application/opensearchdescription+xml; charset=utf-8
1136 <?xml version="1.0" encoding="UTF-8"?>
1137 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1138 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1139 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1140 <ShortName>$lib</ShortName>
1141 <LongName>Search $lib</LongName>
1142 <Description>Search the $lib OPAC by $class.</Description>
1143 <Tags>$lib book library</Tags>
1144 <SampleSearch>harry+potter</SampleSearch>
1145 <Developer>Mike Rylander for GPLS/PINES</Developer>
1146 <Contact>feedback\@open-ils.org</Contact>
1147 <SyndicationRight>open</SyndicationRight>
1148 <AdultContent>false</AdultContent>
1149 </OpenSearchDescription>
1153 Content-type: application/opensearchdescription+xml; charset=utf-8
1155 <?xml version="1.0" encoding="UTF-8"?>
1156 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1157 <ShortName>$lib</ShortName>
1158 <Description>Search the $lib OPAC by $class.</Description>
1159 <Tags>$lib book library</Tags>
1160 <Url type="application/rss+xml"
1161 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1162 <Url type="application/atom+xml"
1163 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1164 <Url type="application/x-mods3+xml"
1165 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1166 <Url type="application/x-mods+xml"
1167 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1168 <Url type="application/x-marcxml+xml"
1169 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1170 <Url type="text/html"
1171 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1172 <LongName>Search $lib</LongName>
1173 <Query role="example" searchTerms="harry+potter" />
1174 <Developer>Mike Rylander for GPLS/PINES</Developer>
1175 <Contact>feedback\@open-ils.org</Contact>
1176 <SyndicationRight>open</SyndicationRight>
1177 <AdultContent>false</AdultContent>
1178 <Language>en-US</Language>
1179 <OutputEncoding>UTF-8</OutputEncoding>
1180 <InputEncoding>UTF-8</InputEncoding>
1181 </OpenSearchDescription>
1185 return Apache2::Const::OK;
1188 sub opensearch_feed {
1190 return Apache2::Const::DECLINED if (-e $apache->filename);
1193 my $year = (gmtime())[5] + 1900;
1195 my $host = $cgi->virtual_host || $cgi->server_name;
1198 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1199 my $rel_name = $cgi->url(-relative=>1);
1200 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1203 my $url = $cgi->url(-path_info=>$add_path);
1204 my $root = (split 'opensearch', $url)[0];
1205 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1206 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1208 my $path = $cgi->path_info;
1209 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1211 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1217 if (!$lib || $lib eq '-') {
1218 $lib = $actor->request(
1219 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1220 )->gather(1)->[0]->shortname;
1223 if ($class eq '-') {
1227 return opensearch_osd($version, $lib, $class, $base);
1231 my $page = $cgi->param('startPage') || 1;
1232 my $offset = $cgi->param('startIndex') || 1;
1233 my $limit = $cgi->param('count') || 10;
1235 $page = 1 if ($page !~ /^\d+$/);
1236 $offset = 1 if ($offset !~ /^\d+$/);
1237 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1240 $offset = ($page - 1) * $limit;
1245 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1246 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1248 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1249 $lang = '' if ($lang eq '*');
1251 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1253 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1256 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1257 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1259 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1262 $type = $cgi->param('responseType') if $cgi->param('responseType');
1265 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1269 my $kwt = $cgi->param('kw');
1270 my $tit = $cgi->param('ti');
1271 my $aut = $cgi->param('au');
1272 my $sut = $cgi->param('su');
1273 my $set = $cgi->param('se');
1275 $terms .= " " if ($terms && $kwt);
1276 $terms .= "keyword: $kwt" if ($kwt);
1277 $terms .= " " if ($terms && $tit);
1278 $terms .= "title: $tit" if ($tit);
1279 $terms .= " " if ($terms && $aut);
1280 $terms .= "author: $aut" if ($aut);
1281 $terms .= " " if ($terms && $sut);
1282 $terms .= "subject: $sut" if ($sut);
1283 $terms .= " " if ($terms && $set);
1284 $terms .= "series: $set" if ($set);
1286 if ($version eq '1.0') {
1288 } elsif ($type eq '-') {
1291 my $flesh_feed = parse_feed_type($type);
1293 $terms = decode_utf8($terms);
1294 $lang = 'eng' if ($lang eq 'en-US');
1296 $log->debug("OpenSearch terms: $terms");
1298 my $org_unit = get_ou($org);
1300 # Apostrophes break search and get indexed as spaces anyway
1301 my $safe_terms = $terms;
1302 $safe_terms =~ s{'}{ }go;
1304 my $recs = $search->request(
1305 'open-ils.search.biblio.multiclass.query' => {
1306 org_unit => $org_unit->[0]->id,
1310 sort_dir => $sortdir,
1311 default_class => $class,
1312 ($lang ? ( 'language' => $lang ) : ()),
1313 } => $safe_terms => 1
1316 $log->debug("Hits for [$terms]: $recs->{count}");
1318 my $feed = create_record_feed(
1321 [ map { $_->[0] } @{$recs->{ids}} ],
1328 $log->debug("Feed created...");
1332 $feed->search($safe_terms);
1333 $feed->class($class);
1335 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1337 $feed->creator($host);
1340 $feed->_create_node(
1341 $feed->{item_xpath},
1342 'http://a9.com/-/spec/opensearch/1.1/',
1347 $feed->_create_node(
1348 $feed->{item_xpath},
1349 'http://a9.com/-/spec/opensearch/1.1/',
1354 $feed->_create_node(
1355 $feed->{item_xpath},
1356 'http://a9.com/-/spec/opensearch/1.1/',
1361 $log->debug("...basic feed data added...");
1365 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1366 'application/opensearch+xml'
1367 ) if ($offset + $limit < $recs->{count});
1371 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1372 'application/opensearch+xml'
1377 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1378 'application/opensearch+xml'
1383 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1384 'application/rss+xml'
1389 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1390 'application/atom+xml'
1395 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1401 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1405 $feed->link( 'unapi-server' => $unapi);
1407 $log->debug("...feed links added...");
1411 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1412 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1416 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1417 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1419 $log->debug("...and feed returned.");
1421 return Apache2::Const::OK;
1424 sub create_record_feed {
1427 my $records = shift;
1430 my $lib = uc(shift()) || '-';
1437 my $base = $cgi->url;
1438 my $host = $cgi->virtual_host || $cgi->server_name;
1440 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1444 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1446 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1448 $type =~ s/(-full|-uris)$//o;
1450 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1451 $feed->base($base) if ($flesh);
1452 $feed->unapi($unapi) if ($flesh);
1454 $type = 'atom' if ($type eq 'html');
1455 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1457 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1460 for my $record (@$records) {
1461 next unless($record);
1463 #my $rec = $record->id;
1466 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1467 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1468 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1469 $item_tag .= "/$depth" if (defined($depth));
1471 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1473 my $xml = $supercat->request(
1474 "open-ils.supercat.$search.$type.retrieve",
1479 my $node = $feed->add_item($xml);
1483 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0 || $flesh eq 'uris')) {
1484 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1485 while ( !$r->complete ) {
1486 $xml .= join('', map {$_->content} $r->recv);
1488 $xml .= join('', map {$_->content} $r->recv);
1489 $node->add_holdings($xml);
1492 $node->id($item_tag);
1493 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1494 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1495 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1496 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1497 $node->link('unapi-id' => $item_tag) if ($flesh);
1505 return Apache2::Const::DECLINED if (-e $apache->filename);
1508 my $year = (gmtime())[5] + 1900;
1510 my $host = $cgi->virtual_host || $cgi->server_name;
1513 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1514 my $rel_name = $cgi->url(-relative=>1);
1515 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1518 my $url = $cgi->url(-path_info=>$add_path);
1519 my $root = (split 'browse', $url)[0];
1520 my $base = (split 'browse', $url)[0] . 'browse';
1521 my $unapi = (split 'browse', $url)[0] . 'unapi';
1523 my $path = $cgi->path_info;
1526 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1527 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1529 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1531 my $status = [$cgi->param('status')];
1532 my $cpLoc = [$cgi->param('copyLocation')];
1533 $site ||= $cgi->param('searchOrg');
1534 $page ||= $cgi->param('startPage') || 0;
1535 $page_size ||= $cgi->param('count') || 9;
1537 $page = 0 if ($page !~ /^-?\d+$/);
1538 $page_size = 9 if $page_size !~ /^\d+$/;
1540 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1541 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1543 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1544 warn "something's wrong...";
1545 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1549 $string = decode_utf8($string);
1550 $string =~ s/\+/ /go;
1553 my $tree = $supercat->request(
1554 "open-ils.supercat.$axis.browse",
1556 (($axis =~ /^authority/) ? () : ($site)),
1563 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1565 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1566 print $header.$content;
1567 return Apache2::Const::OK;
1570 sub string_startwith {
1572 return Apache2::Const::DECLINED if (-e $apache->filename);
1575 my $year = (gmtime())[5] + 1900;
1577 my $host = $cgi->virtual_host || $cgi->server_name;
1580 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1581 my $rel_name = $cgi->url(-relative=>1);
1582 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1585 my $url = $cgi->url(-path_info=>$add_path);
1586 my $root = (split 'startwith', $url)[0];
1587 my $base = (split 'startwith', $url)[0] . 'startwith';
1588 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1590 my $path = $cgi->path_info;
1593 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1594 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1596 my $status = [$cgi->param('status')];
1597 my $cpLoc = [$cgi->param('copyLocation')];
1598 $site ||= $cgi->param('searchOrg');
1599 $page ||= $cgi->param('startPage') || 0;
1600 $page_size ||= $cgi->param('count') || 9;
1602 $page = 0 if ($page !~ /^-?\d+$/);
1603 $page_size = 9 if $page_size !~ /^\d+$/;
1605 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1606 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1608 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1609 warn "something's wrong...";
1610 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1614 $string = decode_utf8($string);
1615 $string =~ s/\+/ /go;
1618 my $tree = $supercat->request(
1619 "open-ils.supercat.$axis.startwith",
1621 (($axis =~ /^authority/) ? () : ($site)),
1628 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1630 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1631 print $header.$content;
1632 return Apache2::Const::OK;
1635 sub item_age_browse {
1637 return Apache2::Const::DECLINED if (-e $apache->filename);
1640 my $year = (gmtime())[5] + 1900;
1642 my $host = $cgi->virtual_host || $cgi->server_name;
1645 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1646 my $rel_name = $cgi->url(-relative=>1);
1647 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1650 my $url = $cgi->url(-path_info=>$add_path);
1651 my $root = (split 'browse', $url)[0];
1652 my $base = (split 'browse', $url)[0] . 'browse';
1653 my $unapi = (split 'browse', $url)[0] . 'unapi';
1655 my $path = $cgi->path_info;
1658 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1659 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1661 unless ($axis eq 'item-age') {
1662 warn "something's wrong...";
1663 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1667 my $status = [$cgi->param('status')];
1668 my $cpLoc = [$cgi->param('copyLocation')];
1669 $site ||= $cgi->param('searchOrg') || '-';
1670 $page ||= $cgi->param('startPage') || 1;
1671 $page_size ||= $cgi->param('count') || 10;
1673 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1674 $page_size = 10 if $page_size !~ /^\d+$/;
1676 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1677 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1679 my $recs = $supercat->request(
1680 "open-ils.supercat.new_book_list",
1688 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1690 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1691 print $header.$content;
1692 return Apache2::Const::OK;
1695 our %qualifier_ids = (
1696 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1697 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1698 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1702 # Our authority search options are currently pretty impoverished;
1703 # just right-truncated string match on a few categories, or by
1705 our %nested_auth_qualifier_map = (
1707 id => { index => 'id', title => 'Record number'},
1708 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1709 title => { index => 'title', title => 'Uniform title'},
1710 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1711 topic => { index => 'topic', title => 'Topical term'},
1715 my $base_explain = <<XML;
1717 id="evergreen-sru-explain-full"
1718 authoritative="true"
1719 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1720 xmlns="http://explain.z3950.org/dtd/2.0/">
1721 <serverInfo transport="http" protocol="SRU" version="1.1">
1728 <title primary="true"/>
1729 <description primary="true"/>
1733 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1738 identifier="info:srw/schema/1/marcxml-v1.1"
1739 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1743 <title>MARC21Slim (marcxml)</title>
1748 <default type="numberOfRecords">10</default>
1749 <default type="contextSet">eg</default>
1750 <default type="index">keyword</default>
1751 <default type="relation">all</default>
1752 <default type="sortSchema">marcxml</default>
1753 <default type="retrieveSchema">marcxml</default>
1754 <setting type="maximumRecords">50</setting>
1755 <supports type="relationModifier">relevant</supports>
1756 <supports type="relationModifier">stem</supports>
1757 <supports type="relationModifier">fuzzy</supports>
1758 <supports type="relationModifier">word</supports>
1769 my $req = SRU::Request->newFromCGI( $cgi );
1770 my $resp = SRU::Response->newFromRequest( $req );
1772 # Find the org_unit shortname, if passed as part of the URL
1773 # http://example.com/opac/extras/sru/SHORTNAME
1774 my $url = $cgi->path_info;
1775 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1777 if ( $resp->type eq 'searchRetrieve' ) {
1779 # Older versions of Debian packages returned terms to us double-encoded,
1780 # so we had to forcefully double-decode them a second time with
1781 # an outer decode('utf8', $string) call; this seems to be resolved with
1782 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1783 my $cql_query = decode_utf8($req->query);
1784 my $search_string = decode_utf8($req->cql->toEvergreen);
1786 # Ensure the search string overrides the default site
1787 if ($shortname and $search_string !~ m#site:#) {
1788 $search_string .= " site:$shortname";
1791 my $offset = $req->startRecord;
1792 $offset-- if ($offset);
1795 my $limit = $req->maximumRecords;
1798 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1800 my $recs = $search->request(
1801 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1804 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1806 foreach my $record (@$bre) {
1807 my $marcxml = $record->marc;
1808 # Make the beast conform to a VDX-supported format
1809 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1810 # Trying to implement LIBSOL_852_A format; so much for standards
1812 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1813 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1815 # Force record leader to 'a' as our data is always UTF8
1816 # Avoids marc8_to_utf8 from being invoked with horrible results
1817 # on the off-chance the record leader isn't correct
1818 my $ldr = $marc->leader;
1819 substr($ldr, 9, 1, 'a');
1820 $marc->leader($ldr);
1822 # Expects the record ID in the 001
1823 $marc->delete_field($_) for ($marc->field('001'));
1824 if (!$marc->field('001')) {
1825 $marc->insert_fields_ordered(
1826 MARC::Field->new( '001', $record->id )
1829 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1830 foreach my $cn (keys %$bib_holdings) {
1831 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1832 $marc->insert_fields_ordered(
1835 a => $cp->{'location'},
1836 b => $bib_holdings->{$cn}->{'owning_lib'},
1838 d => $cp->{'circlib'},
1839 g => $cp->{'barcode'},
1840 n => $cp->{'status'},
1846 # Ensure the data is encoded as UTF8 before we hand it off
1847 $marcxml = encode_utf8($marc->as_xml_record());
1848 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1852 SRU::Response::Record->new(
1853 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1854 recordData => $marcxml,
1855 recordPosition => ++$offset
1860 $resp->numberOfRecords($recs->{count});
1862 } elsif ( $resp->type eq 'explain' ) {
1863 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1865 \%OpenILS::WWW::SuperCat::qualifier_ids
1869 SRU::Response::Record->new(
1870 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1871 recordData => $ex_doc
1876 print $cgi->header( -type => 'application/xml' );
1877 print $U->entityize($resp->asXML) . "\n";
1878 return Apache2::Const::OK;
1883 package CQL::BooleanNode;
1887 my $left = $self->left();
1888 my $right = $self->right();
1889 my $leftStr = $left->toEvergreen;
1890 my $rightStr = $right->toEvergreen();
1892 my $op = '||' if uc $self->op() eq 'OR';
1895 return "$leftStr $rightStr";
1898 sub toEvergreenAuth {
1899 return toEvergreen(shift);
1902 package CQL::TermNode;
1906 my $qualifier = $self->getQualifier();
1907 my $term = $self->getTerm();
1908 my $relation = $self->getRelation();
1912 my ($qset, $qname) = split(/\./, $qualifier);
1914 if ( exists($qualifier_map{$qset}{$qname}) ) {
1915 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1916 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1919 my @modifiers = $relation->getModifiers();
1921 my $base = $relation->getBase();
1922 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1925 foreach my $m ( @modifiers ) {
1926 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1932 $quote_it = 0 if ( $base eq 'all' );
1933 $term = maybeQuote($term) if $quote_it;
1936 croak( "Evergreen doesn't support the $base relations" );
1944 return "$qualifier:$term";
1947 sub toEvergreenAuth {
1949 my $qualifier = $self->getQualifier();
1950 my $term = $self->getTerm();
1951 my $relation = $self->getRelation();
1955 my ($qset, $qname) = split(/\./, $qualifier);
1957 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1958 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1959 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1962 return { qualifier => $qualifier, term => $term };
1967 sub sru_auth_search {
1970 my $req = SRU::Request->newFromCGI( $cgi );
1971 my $resp = SRU::Response->newFromRequest( $req );
1973 if ( $resp->type eq 'searchRetrieve' ) {
1974 return_auth_response($cgi, $req, $resp);
1975 } elsif ( $resp->type eq 'explain' ) {
1976 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1977 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1978 \%OpenILS::WWW::SuperCat::qualifier_ids
1982 print $cgi->header( -type => 'application/xml' );
1983 print $U->entityize($resp->asXML) . "\n";
1984 return Apache2::Const::OK;
1987 sub explain_header {
1990 my $host = $cgi->virtual_host || $cgi->server_name;
1993 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1994 my $rel_name = $cgi->url(-relative=>1);
1995 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1997 my $base = $cgi->url(-base=>1);
1998 my $url = $cgi->url(-path_info=>$add_path);
1999 $url =~ s/^$base\///o;
2001 my $doc = $parser->parse_string($base_explain);
2002 my $e = $doc->documentElement;
2003 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2004 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2005 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2010 sub return_sru_explain {
2011 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2013 $index_map ||= \%qualifier_map;
2015 my ($doc, $e) = explain_header($cgi);
2016 for my $name ( keys %{$index_map} ) {
2018 my $identifier = $qualifier_ids->{ $name };
2020 next unless $identifier;
2022 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2023 $set_node->setAttribute( identifier => $identifier );
2024 $set_node->setAttribute( name => $name );
2026 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2027 for my $index ( sort keys %{$index_map->{$name}} ) {
2028 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2030 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2031 $map_node->appendChild( $name_node );
2033 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2035 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2036 $index_node->appendChild( $title_node );
2037 $index_node->appendChild( $map_node );
2039 $index_node->setAttribute( id => "$name.$index" );
2040 $title_node->appendText($index_map->{$name}{$index}{'title'});
2041 $name_node->setAttribute( set => $name );
2042 $name_node->appendText($index_map->{$name}{$index}{'index'});
2044 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2048 $$explain = $e->toString;
2052 SRU::Response::Record->new(
2053 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2054 recordData => $$explain
2060 sub return_auth_response {
2061 my ($cgi, $req, $resp) = @_;
2063 my $cql_query = decode_utf8($req->query);
2064 my $search = $req->cql->toEvergreenAuth;
2066 my $qualifier = decode_utf8($search->{qualifier});
2067 my $term = decode_utf8($search->{term});
2069 $log->info("SRU NAF search string [$cql_query] converted to "
2070 . "[$qualifier:$term]\n");
2072 my $page_size = $req->maximumRecords;
2075 # startwith deals with pages, so convert startRecord to a page number
2076 my $page = ($req->startRecord / $page_size) || 0;
2079 if ($qualifier eq "id") {
2080 $recs = [ int($term) ];
2082 $recs = $supercat->request(
2083 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2087 my $record_position = $req->startRecord;
2088 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2089 foreach my $record (@$recs) {
2090 my $marcxml = $cstore->request(
2091 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2095 SRU::Response::Record->new(
2096 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2097 recordData => $marcxml,
2098 recordPosition => ++$record_position
2103 $resp->numberOfRecords(scalar(@$recs));
2106 =head2 get_ou($org_unit)
2108 Returns an aou object for a given actor.org_unit shortname or ID.
2113 my $org = shift || '-';
2117 $org_unit = $actor->request(
2118 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2120 } elsif ($org !~ /^\d+$/o) {
2121 $org_unit = $actor->request(
2122 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2125 $org_unit = $actor->request(
2126 'open-ils.actor.org_unit_list.search' => id => $org