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")
151 ->request("open-ils.supercat.record.formats")
154 $list = [ map { (keys %$_)[0] } @$list ];
155 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
157 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
158 for my $record_browse_format ( @$list ) {
160 my $__f = $record_browse_format;
161 my $__a = $browse_axis;
163 $browse_types{$__a}{$__f} = sub {
164 my $record_list = shift;
167 my $real_format = shift || $__f;
172 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
173 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
174 $feed->root( "$base/../" );
176 $feed->link( next => $next => $feed->type );
177 $feed->link( previous => $prev => $feed->type );
180 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
188 for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
189 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
192 my $__a = $browse_axis;
194 $browse_types{$__a}{$__f} = sub {
195 my $record_list = shift;
198 my $real_format = shift || $__f;
203 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
204 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
205 $feed->root( "$base/../" );
206 $feed->link( next => $next => $feed->type );
207 $feed->link( previous => $prev => $feed->type );
210 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
219 =head2 parse_feed_type($type)
221 Determines whether and how a given feed type needs to be "fleshed out"
222 with holdings information.
224 The feed type could end with the string "-full", in which case we want
225 to return call numbers, copies, and URIS.
227 Or the feed type could be "-uris", in which case we want to return
228 call numbers and URIS.
230 Otherwise, we won't return any holdings.
234 sub parse_feed_type {
237 if ($type =~ /-full$/o) {
241 if ($type =~ /-uris$/o) {
245 # Otherwise, we'll return just the facts, ma'am
249 =head2 supercat_format($format_hashref, $format_type)
251 Given a reference to a hash containing the namespace_uri,
252 docs, and schema location attributes for a set of formats,
253 generate the XML description required by the supercat service.
255 We derive the base type from the format type so that we do not
256 have to populate the hash with redundant information.
260 sub supercat_format {
264 (my $base_type = $type) =~ s/(-full|-uris)$//o;
266 my $format = "<format><name>$type</name><type>application/xml</type>";
268 for my $part ( qw/namespace_uri docs schema_location/ ) {
269 $format .= "<$part>$$h{$base_type}{$part}</$part>"
270 if ($$h{$base_type}{$part});
273 $format .= '</format>';
278 =head2 unapi_format($format_hashref, $format_type)
280 Given a reference to a hash containing the namespace_uri,
281 docs, and schema location attributes for a set of formats,
282 generate the XML description required by the supercat service.
284 We derive the base type from the format type so that we do not
285 have to populate the hash with redundant information.
293 (my $base_type = $type) =~ s/(-full|-uris)$//o;
295 my $format = "<format name='$type' type='application/xml'";
297 for my $part ( qw/namespace_uri docs schema_location/ ) {
298 $format .= " $part='$$h{$base_type}{$part}'"
299 if ($$h{$base_type}{$part});
311 return Apache2::Const::DECLINED if (-e $apache->filename);
313 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
316 ->request("open-ils.supercat.oisbn", $isbn)
319 print "Content-type: application/xml; charset=utf-8\n\n";
320 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
322 unless (exists $$list{metarecord}) {
324 return Apache2::Const::OK;
327 print "<idlist metarecord='$$list{metarecord}'>\n";
329 for ( keys %{ $$list{record_list} } ) {
330 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
331 print " <isbn record='$_'>$o</isbn>\n"
336 return Apache2::Const::OK;
342 return Apache2::Const::DECLINED if (-e $apache->filename);
347 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
348 my $rel_name = $cgi->url(-relative=>1);
349 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
352 my $url = $cgi->url(-path_info=>$add_path);
353 my $root = (split 'unapi', $url)[0];
354 my $base = (split 'unapi', $url)[0] . 'unapi';
357 my $uri = $cgi->param('id') || '';
358 my $host = $cgi->virtual_host || $cgi->server_name;
360 my $skin = $cgi->param('skin') || 'default';
361 my $locale = $cgi->param('locale') || 'en-US';
363 # Enable localized results of copy status, etc
364 $supercat->session_locale($locale);
366 my $format = $cgi->param('format');
367 my $flesh_feed = parse_feed_type($format);
368 (my $base_format = $format) =~ s/(-full|-uris)$//o;
369 my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
372 my $body = "Content-type: application/xml; charset=utf-8\n\n";
374 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
377 ($lib,$depth) = split('/', $4);
379 $type = 'metarecord' if ($1 =~ /^m/o);
380 $type = 'authority' if ($1 =~ /^authority/o);
383 ->request("open-ils.supercat.$type.formats")
386 if ($type eq 'record' or $type eq 'isbn') {
387 $body .= <<" FORMATS";
389 <format name='opac' type='text/html'/>
390 <format name='html' type='text/html'/>
391 <format name='htmlholdings' type='text/html'/>
392 <format name='holdings_xml' type='application/xml'/>
393 <format name='holdings_xml-full' type='application/xml'/>
394 <format name='html-full' type='text/html'/>
395 <format name='htmlholdings-full' type='text/html'/>
396 <format name='marctxt' type='text/plain'/>
397 <format name='ris' type='text/plain'/>
399 } elsif ($type eq 'metarecord') {
400 $body .= <<" FORMATS";
402 <format name='opac' type='text/html'/>
405 $body .= <<" FORMATS";
411 my ($type) = keys %$h;
412 $body .= unapi_format($h, $type);
414 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
415 $body .= unapi_format($h, "$type-full");
416 $body .= unapi_format($h, "$type-uris");
420 $body .= "</formats>\n";
424 ->request("open-ils.supercat.$type.formats")
429 ->request("open-ils.supercat.metarecord.formats")
433 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
434 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
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'/>
451 my ($type) = keys %$h;
452 $body .= "\t" . unapi_format($h, $type);
454 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
455 $body .= "\t" . unapi_format($h, "$type-full");
456 $body .= "\t" . unapi_format($h, "$type-uris");
460 $body .= "</formats>\n";
464 return Apache2::Const::OK;
468 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
472 ($lib,$depth) = split('/', $4);
474 $type = 'metarecord' if ($scheme =~ /^metabib/o);
475 $type = 'isbn' if ($scheme =~ /^isbn/o);
476 $type = 'acp' if ($scheme =~ /^asset-copy/o);
477 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
478 $type = 'auri' if ($scheme =~ /^asset-uri/o);
479 $type = 'authority' if ($scheme =~ /^authority/o);
480 $command = 'retrieve';
481 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
485 $paging = [split ',', $paging];
490 if (!$lib || $lib eq '-') {
491 $lib = $actor->request(
492 'open-ils.actor.org_unit_list.search' => parent_ou => undef
493 )->gather(1)->[0]->shortname;
496 my ($lib_object,$lib_id,$ou_types,$lib_depth);
497 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
498 $lib_object = $actor->request(
499 'open-ils.actor.org_unit_list.search' => shortname => $lib
501 $lib_id = $lib_object->id;
503 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
504 $lib_depth = $depth || (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
507 if ($command eq 'browse') {
508 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
512 if ($type eq 'isbn') {
513 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
515 print "Content-type: text/html; charset=utf-8\n\n";
516 $apache->custom_response( 404, <<" HTML");
519 <title>Type [$type] with id [$id] not found!</title>
523 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
534 { (keys(%$_))[0] eq $base_format }
535 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
537 { $_ eq $base_format }
538 qw/opac html htmlholdings marctxt ris holdings_xml/
540 print "Content-type: text/html; charset=utf-8\n\n";
541 $apache->custom_response( 406, <<" HTML");
544 <title>Invalid format [$format] for type [$type]!</title>
548 <center>Sorry, format $format is not valid for type $type.</center>
555 if ($format eq 'opac') {
556 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
557 if ($type eq 'metarecord');
558 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
559 if ($type eq 'record');
561 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
562 my $feed = create_record_feed(
573 print "Content-type: text/html; charset=utf-8\n\n";
574 $apache->custom_response( 404, <<" HTML");
577 <title>Type [$type] with id [$id] not found!</title>
581 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
589 $feed->creator($host);
591 $feed->link( unapi => $base) if ($flesh_feed);
593 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
594 print $U->entityize($feed->toString) . "\n";
596 return Apache2::Const::OK;
599 my $method = "open-ils.supercat.$type.$base_format.$command";
601 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
603 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
604 # however, we can have it carry extra options like no_record! (comma separated)
605 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
607 my $req = $supercat->request($method,@params);
608 my $data = $req->gather();
610 if ($req->failed || !$data) {
611 print "Content-type: text/html; charset=utf-8\n\n";
612 $apache->custom_response( 404, <<" HTML");
615 <title>$type $id not found!</title>
619 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
626 print "Content-type: application/xml; charset=utf-8\n\n$data";
628 if ($base_format eq 'holdings_xml') {
629 while (my $c = $req->recv) {
634 return Apache2::Const::OK;
640 return Apache2::Const::DECLINED if (-e $apache->filename);
645 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
646 my $rel_name = $cgi->url(-relative=>1);
647 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
650 my $url = $cgi->url(-path_info=>$add_path);
651 my $root = (split 'supercat', $url)[0];
652 my $base = (split 'supercat', $url)[0] . 'supercat';
653 my $unapi = (split 'supercat', $url)[0] . 'unapi';
655 my $host = $cgi->virtual_host || $cgi->server_name;
657 my $path = $cgi->path_info;
658 my ($id,$type,$format,$command) = reverse split '/', $path;
659 my $flesh_feed = parse_feed_type($format);
660 (my $base_format = $format) =~ s/(-full|-uris)$//o;
662 my $skin = $cgi->param('skin') || 'default';
663 my $locale = $cgi->param('locale') || 'en-US';
665 # Enable localized results of copy status, etc
666 $supercat->session_locale($locale);
668 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
669 print "Content-type: application/xml; charset=utf-8\n";
672 ->request("open-ils.supercat.$1.formats")
680 <type>text/html</type>
683 if ($1 eq 'record' or $1 eq 'isbn') {
685 <name>htmlholdings</name>
686 <type>text/html</type>
690 <type>text/html</type>
693 <name>htmlholdings-full</name>
694 <type>text/html</type>
697 <name>html-full</name>
698 <type>text/html</type>
702 <type>text/plain</type>
706 <type>text/plain</type>
711 my ($type) = keys %$h;
712 print supercat_format($h, $type);
714 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
715 print supercat_format($h, "$type-full");
716 print supercat_format($h, "$type-uris");
721 print "</formats>\n";
723 return Apache2::Const::OK;
727 ->request("open-ils.supercat.record.formats")
732 ->request("open-ils.supercat.metarecord.formats")
736 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
737 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
742 <type>text/html</type>
745 <name>htmlholdings</name>
746 <type>text/html</type>
750 <type>text/html</type>
753 <name>htmlholdings-full</name>
754 <type>text/html</type>
757 <name>html-full</name>
758 <type>text/html</type>
762 <type>text/plain</type>
766 <type>text/plain</type>
770 my ($type) = keys %$h;
771 print supercat_format($h, $type);
773 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
774 print supercat_format($h, "$type-full");
775 print supercat_format($h, "$type-uris");
780 print "</formats>\n";
783 return Apache2::Const::OK;
786 if ($format eq 'opac') {
787 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
788 if ($type eq 'metarecord');
789 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
790 if ($type eq 'record');
793 } elsif ($base_format eq 'marc21') {
797 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
799 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
804 print "Content-type: text/html; charset=utf-8\n\n";
805 $apache->custom_response( 404, <<" HTML");
812 <center>Couldn't fetch $id as MARC21.</center>
819 return Apache2::Const::OK;
821 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
822 my $feed = create_record_feed(
830 $feed->creator($host);
834 $feed->link( unapi => $base) if ($flesh_feed);
836 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
837 print $U->entityize($feed->toString) . "\n";
839 return Apache2::Const::OK;
842 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
846 print "Content-type: text/html; charset=utf-8\n\n";
847 $apache->custom_response( 404, <<" HTML");
850 <title>$type $id not found!</title>
854 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
861 print "Content-type: application/xml; charset=utf-8\n\n";
862 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
864 return Apache2::Const::OK;
870 return Apache2::Const::DECLINED if (-e $apache->filename);
874 my $year = (gmtime())[5] + 1900;
875 my $host = $cgi->virtual_host || $cgi->server_name;
878 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
879 my $rel_name = $cgi->url(-relative=>1);
880 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
883 my $url = $cgi->url(-path_info=>$add_path);
884 my $root = (split 'feed', $url)[0] . '/';
885 my $base = (split 'bookbag', $url)[0] . '/bookbag';
886 my $unapi = (split 'feed', $url)[0] . '/unapi';
888 my $skin = $cgi->param('skin') || 'default';
889 my $locale = $cgi->param('locale') || 'en-US';
890 my $org = $cgi->param('searchOrg');
892 # Enable localized results of copy status, etc
893 $supercat->session_locale($locale);
895 my $org_unit = get_ou($org);
896 my $scope = "l=" . $org_unit->[0]->id . "&";
898 $root =~ s{(?<!http:)//}{/}go;
899 $base =~ s{(?<!http:)//}{/}go;
900 $unapi =~ s{(?<!http:)//}{/}go;
902 my $path = $cgi->path_info;
903 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
905 my ($id,$type) = reverse split '/', $path;
906 my $flesh_feed = parse_feed_type($type);
908 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
909 return Apache2::Const::NOT_FOUND unless($bucket);
911 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
912 if ($type eq 'opac') {
913 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
914 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
919 my $feed = create_record_feed(
922 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
924 $org_unit->[0]->shortname,
929 $feed->id($bucket_tag);
931 $feed->title("Items in Book Bag [".$bucket->name."]");
932 $feed->creator($host);
935 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
936 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
937 $feed->link(html => $base . "/html-full/$id" => 'text/html');
938 $feed->link(unapi => $unapi);
942 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
943 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
948 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
949 print $U->entityize($feed->toString) . "\n";
951 return Apache2::Const::OK;
956 return Apache2::Const::DECLINED if (-e $apache->filename);
960 my $year = (gmtime())[5] + 1900;
961 my $host = $cgi->virtual_host || $cgi->server_name;
964 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
965 my $rel_name = $cgi->url(-relative=>1);
966 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
969 my $url = $cgi->url(-path_info=>$add_path);
970 my $root = (split 'feed', $url)[0];
971 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
972 my $unapi = (split 'feed', $url)[0] . 'unapi';
974 my $skin = $cgi->param('skin') || 'default';
975 my $locale = $cgi->param('locale') || 'en-US';
976 my $org = $cgi->param('searchOrg');
978 # Enable localized results of copy status, etc
979 $supercat->session_locale($locale);
981 my $org_unit = get_ou($org);
982 my $scope = "l=" . $org_unit->[0]->id . "&";
984 my $path = $cgi->path_info;
985 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
987 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
989 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
990 my $flesh_feed = parse_feed_type($type);
993 $limit = 10 if $limit !~ /^\d+$/;
995 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
997 #if ($type eq 'opac') {
998 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
999 # join('&', map { "rl=" . $_ } @$list) .
1004 my $search = 'record';
1005 if ($rtype eq 'authority') {
1006 $search = 'authority';
1008 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1012 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1014 $feed->title("$limit most recent $rtype ${axis}s");
1017 $feed->creator($host);
1020 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1021 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1022 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1023 $feed->link(unapi => $unapi);
1027 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1028 join('&', map { 'rl=' . $_} @$list ),
1033 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1034 print $U->entityize($feed->toString) . "\n";
1036 return Apache2::Const::OK;
1039 sub opensearch_osd {
1040 my $version = shift;
1045 if ($version eq '1.0') {
1047 Content-type: application/opensearchdescription+xml; charset=utf-8
1049 <?xml version="1.0" encoding="UTF-8"?>
1050 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1051 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1052 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1053 <ShortName>$lib</ShortName>
1054 <LongName>Search $lib</LongName>
1055 <Description>Search the $lib OPAC by $class.</Description>
1056 <Tags>$lib book library</Tags>
1057 <SampleSearch>harry+potter</SampleSearch>
1058 <Developer>Mike Rylander for GPLS/PINES</Developer>
1059 <Contact>feedback\@open-ils.org</Contact>
1060 <SyndicationRight>open</SyndicationRight>
1061 <AdultContent>false</AdultContent>
1062 </OpenSearchDescription>
1066 Content-type: application/opensearchdescription+xml; charset=utf-8
1068 <?xml version="1.0" encoding="UTF-8"?>
1069 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1070 <ShortName>$lib</ShortName>
1071 <Description>Search the $lib OPAC by $class.</Description>
1072 <Tags>$lib book library</Tags>
1073 <Url type="application/rss+xml"
1074 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1075 <Url type="application/atom+xml"
1076 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1077 <Url type="application/x-mods3+xml"
1078 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1079 <Url type="application/x-mods+xml"
1080 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1081 <Url type="application/x-marcxml+xml"
1082 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1083 <Url type="text/html"
1084 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1085 <LongName>Search $lib</LongName>
1086 <Query role="example" searchTerms="harry+potter" />
1087 <Developer>Mike Rylander for GPLS/PINES</Developer>
1088 <Contact>feedback\@open-ils.org</Contact>
1089 <SyndicationRight>open</SyndicationRight>
1090 <AdultContent>false</AdultContent>
1091 <Language>en-US</Language>
1092 <OutputEncoding>UTF-8</OutputEncoding>
1093 <InputEncoding>UTF-8</InputEncoding>
1094 </OpenSearchDescription>
1098 return Apache2::Const::OK;
1101 sub opensearch_feed {
1103 return Apache2::Const::DECLINED if (-e $apache->filename);
1106 my $year = (gmtime())[5] + 1900;
1108 my $host = $cgi->virtual_host || $cgi->server_name;
1111 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1112 my $rel_name = $cgi->url(-relative=>1);
1113 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1116 my $url = $cgi->url(-path_info=>$add_path);
1117 my $root = (split 'opensearch', $url)[0];
1118 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1119 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1121 my $path = $cgi->path_info;
1122 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1124 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1130 if (!$lib || $lib eq '-') {
1131 $lib = $actor->request(
1132 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1133 )->gather(1)->[0]->shortname;
1136 if ($class eq '-') {
1140 return opensearch_osd($version, $lib, $class, $base);
1144 my $page = $cgi->param('startPage') || 1;
1145 my $offset = $cgi->param('startIndex') || 1;
1146 my $limit = $cgi->param('count') || 10;
1148 $page = 1 if ($page !~ /^\d+$/);
1149 $offset = 1 if ($offset !~ /^\d+$/);
1150 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1153 $offset = ($page - 1) * $limit;
1158 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1159 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1161 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1162 $lang = '' if ($lang eq '*');
1164 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1166 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1169 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1170 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1172 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1175 $type = $cgi->param('responseType') if $cgi->param('responseType');
1178 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1182 my $kwt = $cgi->param('kw');
1183 my $tit = $cgi->param('ti');
1184 my $aut = $cgi->param('au');
1185 my $sut = $cgi->param('su');
1186 my $set = $cgi->param('se');
1188 $terms .= " " if ($terms && $kwt);
1189 $terms .= "keyword: $kwt" if ($kwt);
1190 $terms .= " " if ($terms && $tit);
1191 $terms .= "title: $tit" if ($tit);
1192 $terms .= " " if ($terms && $aut);
1193 $terms .= "author: $aut" if ($aut);
1194 $terms .= " " if ($terms && $sut);
1195 $terms .= "subject: $sut" if ($sut);
1196 $terms .= " " if ($terms && $set);
1197 $terms .= "series: $set" if ($set);
1199 if ($version eq '1.0') {
1201 } elsif ($type eq '-') {
1204 my $flesh_feed = parse_feed_type($type);
1206 $terms = decode_utf8($terms);
1207 $lang = 'eng' if ($lang eq 'en-US');
1209 $log->debug("OpenSearch terms: $terms");
1211 my $org_unit = get_ou($org);
1213 # Apostrophes break search and get indexed as spaces anyway
1214 my $safe_terms = $terms;
1215 $safe_terms =~ s{'}{ }go;
1217 my $recs = $search->request(
1218 'open-ils.search.biblio.multiclass.query' => {
1219 org_unit => $org_unit->[0]->id,
1223 sort_dir => $sortdir,
1224 default_class => $class,
1225 ($lang ? ( 'language' => $lang ) : ()),
1226 } => $safe_terms => 1
1229 $log->debug("Hits for [$terms]: $recs->{count}");
1231 my $feed = create_record_feed(
1234 [ map { $_->[0] } @{$recs->{ids}} ],
1241 $log->debug("Feed created...");
1245 $feed->search($safe_terms);
1246 $feed->class($class);
1248 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1250 $feed->creator($host);
1253 $feed->_create_node(
1254 $feed->{item_xpath},
1255 'http://a9.com/-/spec/opensearch/1.1/',
1260 $feed->_create_node(
1261 $feed->{item_xpath},
1262 'http://a9.com/-/spec/opensearch/1.1/',
1267 $feed->_create_node(
1268 $feed->{item_xpath},
1269 'http://a9.com/-/spec/opensearch/1.1/',
1274 $log->debug("...basic feed data added...");
1278 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1279 'application/opensearch+xml'
1280 ) if ($offset + $limit < $recs->{count});
1284 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1285 'application/opensearch+xml'
1290 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1291 'application/opensearch+xml'
1296 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1297 'application/rss+xml'
1302 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1303 'application/atom+xml'
1308 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1314 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1318 $feed->link( 'unapi-server' => $unapi);
1320 $log->debug("...feed links added...");
1324 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1325 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1329 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1330 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1332 $log->debug("...and feed returned.");
1334 return Apache2::Const::OK;
1337 sub create_record_feed {
1340 my $records = shift;
1343 my $lib = uc(shift()) || '-';
1350 my $base = $cgi->url;
1351 my $host = $cgi->virtual_host || $cgi->server_name;
1353 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1357 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1359 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1361 $type =~ s/(-full|-uris)$//o;
1363 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1364 $feed->base($base) if ($flesh);
1365 $feed->unapi($unapi) if ($flesh);
1367 $type = 'atom' if ($type eq 'html');
1368 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1370 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1373 for my $record (@$records) {
1374 next unless($record);
1376 #my $rec = $record->id;
1379 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1380 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1381 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1382 $item_tag .= "/$depth" if (defined($depth));
1384 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1386 my $xml = $supercat->request(
1387 "open-ils.supercat.$search.$type.retrieve",
1392 my $node = $feed->add_item($xml);
1396 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && $flesh > 0) {
1397 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1398 while ( !$r->complete ) {
1399 $xml .= join('', map {$_->content} $r->recv);
1401 $xml .= join('', map {$_->content} $r->recv);
1402 $node->add_holdings($xml);
1405 $node->id($item_tag);
1406 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1407 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1408 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1409 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1410 $node->link('unapi-id' => $item_tag) if ($flesh);
1418 return Apache2::Const::DECLINED if (-e $apache->filename);
1421 my $year = (gmtime())[5] + 1900;
1423 my $host = $cgi->virtual_host || $cgi->server_name;
1426 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1427 my $rel_name = $cgi->url(-relative=>1);
1428 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1431 my $url = $cgi->url(-path_info=>$add_path);
1432 my $root = (split 'browse', $url)[0];
1433 my $base = (split 'browse', $url)[0] . 'browse';
1434 my $unapi = (split 'browse', $url)[0] . 'unapi';
1436 my $path = $cgi->path_info;
1439 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1440 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1442 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1444 my $status = [$cgi->param('status')];
1445 my $cpLoc = [$cgi->param('copyLocation')];
1446 $site ||= $cgi->param('searchOrg');
1447 $page ||= $cgi->param('startPage') || 0;
1448 $page_size ||= $cgi->param('count') || 9;
1450 $page = 0 if ($page !~ /^-?\d+$/);
1451 $page_size = 9 if $page_size !~ /^\d+$/;
1453 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1454 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1456 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1457 warn "something's wrong...";
1458 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1462 $string = decode_utf8($string);
1463 $string =~ s/\+/ /go;
1466 my $tree = $supercat->request(
1467 "open-ils.supercat.$axis.browse",
1469 (($axis =~ /^authority/) ? () : ($site)),
1476 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1478 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1479 print $header.$content;
1480 return Apache2::Const::OK;
1483 sub string_startwith {
1485 return Apache2::Const::DECLINED if (-e $apache->filename);
1488 my $year = (gmtime())[5] + 1900;
1490 my $host = $cgi->virtual_host || $cgi->server_name;
1493 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1494 my $rel_name = $cgi->url(-relative=>1);
1495 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1498 my $url = $cgi->url(-path_info=>$add_path);
1499 my $root = (split 'startwith', $url)[0];
1500 my $base = (split 'startwith', $url)[0] . 'startwith';
1501 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1503 my $path = $cgi->path_info;
1506 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1507 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1509 my $status = [$cgi->param('status')];
1510 my $cpLoc = [$cgi->param('copyLocation')];
1511 $site ||= $cgi->param('searchOrg');
1512 $page ||= $cgi->param('startPage') || 0;
1513 $page_size ||= $cgi->param('count') || 9;
1515 $page = 0 if ($page !~ /^-?\d+$/);
1516 $page_size = 9 if $page_size !~ /^\d+$/;
1518 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1519 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1521 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1522 warn "something's wrong...";
1523 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1527 $string = decode_utf8($string);
1528 $string =~ s/\+/ /go;
1531 my $tree = $supercat->request(
1532 "open-ils.supercat.$axis.startwith",
1534 (($axis =~ /^authority/) ? () : ($site)),
1541 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1543 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1544 print $header.$content;
1545 return Apache2::Const::OK;
1548 sub item_age_browse {
1550 return Apache2::Const::DECLINED if (-e $apache->filename);
1553 my $year = (gmtime())[5] + 1900;
1555 my $host = $cgi->virtual_host || $cgi->server_name;
1558 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1559 my $rel_name = $cgi->url(-relative=>1);
1560 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1563 my $url = $cgi->url(-path_info=>$add_path);
1564 my $root = (split 'browse', $url)[0];
1565 my $base = (split 'browse', $url)[0] . 'browse';
1566 my $unapi = (split 'browse', $url)[0] . 'unapi';
1568 my $path = $cgi->path_info;
1571 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1572 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1574 unless ($axis eq 'item-age') {
1575 warn "something's wrong...";
1576 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1580 my $status = [$cgi->param('status')];
1581 my $cpLoc = [$cgi->param('copyLocation')];
1582 $site ||= $cgi->param('searchOrg') || '-';
1583 $page ||= $cgi->param('startPage') || 1;
1584 $page_size ||= $cgi->param('count') || 10;
1586 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1587 $page_size = 10 if $page_size !~ /^\d+$/;
1589 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1590 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1592 my $recs = $supercat->request(
1593 "open-ils.supercat.new_book_list",
1601 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1603 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1604 print $header.$content;
1605 return Apache2::Const::OK;
1608 our %qualifier_ids = (
1609 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1610 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1611 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1615 our %nested_qualifier_map = (
1617 site => ['site','Evergreen Site Code (shortname)'],
1618 sort => ['sort','Sort on relevance, title, author, pubdate, create_date or edit_date'],
1619 direction => ['dir','Sort direction (asc|desc)'],
1620 available => ['available','Filter to available (true|false)'],
1622 author => ['author'],
1624 subject => ['subject'],
1625 keyword => ['keyword'],
1626 series => ['series'],
1630 creator => ['author'],
1631 contributor => ['author'],
1632 publisher => ['keyword'],
1633 subject => ['subject'],
1634 identifier => ['keyword'],
1637 language => ['lang'],
1641 titleAbbreviated => ['title'],
1642 titleUniform => ['title'],
1643 titleTranslated => ['title'],
1644 titleAlternative => ['title'],
1645 titleSeries => ['series'],
1647 # Author/Name class:
1649 namePersonal => ['author'],
1650 namePersonalFamily => ['author'],
1651 namePersonalGiven => ['author'],
1652 nameCorporate => ['author'],
1653 nameConference => ['author'],
1656 subjectPlace => ['subject'],
1657 subjectTitle => ['keyword'],
1658 subjectName => ['subject|name'],
1659 subjectOccupation => ['keyword'],
1664 dateIssued => [undef],
1665 dateCreated => [undef],
1666 dateValid => [undef],
1667 dateModified => [undef],
1668 dateCopyright => [undef],
1671 genre => ['keyword'],
1674 audience => [undef],
1677 originPlace => [undef],
1680 edition => ['keyword'],
1683 volume => ['keyword'],
1684 issue => ['keyword'],
1685 startPage => ['keyword'],
1686 endPage => ['keyword'],
1689 issuance => ['keyword'],
1692 serverChoice => ['keyword'],
1696 # Our authority search options are currently pretty impoverished;
1697 # just right-truncated string match on a few categories, or by
1699 our %nested_auth_qualifier_map = (
1701 id => ['id', 'Record number'],
1702 name => ['author', 'Personal or corporate author, or meeting name'],
1703 title => ['title', 'Uniform title'],
1704 subject => ['subject', 'Chronological term, topical term, geographic name, or genre/form term'],
1705 topic => ['topic', 'Topical term'],
1709 my $base_explain = <<XML;
1711 id="evergreen-sru-explain-full"
1712 authoritative="true"
1713 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1714 xmlns="http://explain.z3950.org/dtd/2.0/">
1715 <serverInfo transport="http" protocol="SRU" version="1.1">
1722 <title primary="true"/>
1723 <description primary="true"/>
1727 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1732 identifier="info:srw/schema/1/marcxml-v1.1"
1733 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1737 <title>MARC21Slim (marcxml)</title>
1742 <default type="numberOfRecords">10</default>
1743 <default type="contextSet">eg</default>
1744 <default type="index">keyword</default>
1745 <default type="relation">all</default>
1746 <default type="sortSchema">marcxml</default>
1747 <default type="retrieveSchema">marcxml</default>
1748 <setting type="maximumRecords">50</setting>
1749 <supports type="relationModifier">relevant</supports>
1750 <supports type="relationModifier">stem</supports>
1751 <supports type="relationModifier">fuzzy</supports>
1752 <supports type="relationModifier">word</supports>
1763 my $req = SRU::Request->newFromCGI( $cgi );
1764 my $resp = SRU::Response->newFromRequest( $req );
1766 # Find the org_unit shortname, if passed as part of the URL
1767 # http://example.com/opac/extras/sru/SHORTNAME
1768 my $url = $cgi->path_info;
1769 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1771 if ( $resp->type eq 'searchRetrieve' ) {
1773 # Older versions of Debian packages returned terms to us double-encoded,
1774 # so we had to forcefully double-decode them a second time with
1775 # an outer decode('utf8', $string) call; this seems to be resolved with
1776 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1777 my $cql_query = decode_utf8($req->query);
1778 my $search_string = decode_utf8($req->cql->toEvergreen);
1780 # Ensure the search string overrides the default site
1781 if ($shortname and $search_string !~ m#site:#) {
1782 $search_string .= " site:$shortname";
1785 my $offset = $req->startRecord;
1786 $offset-- if ($offset);
1789 my $limit = $req->maximumRecords;
1792 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1794 my $recs = $search->request(
1795 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1798 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1800 foreach my $record (@$bre) {
1801 my $marcxml = $record->marc;
1802 # Make the beast conform to a VDX-supported format
1803 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1804 # Trying to implement LIBSOL_852_A format; so much for standards
1806 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1807 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1809 # Force record leader to 'a' as our data is always UTF8
1810 # Avoids marc8_to_utf8 from being invoked with horrible results
1811 # on the off-chance the record leader isn't correct
1812 my $ldr = $marc->leader;
1813 substr($ldr, 9, 1, 'a');
1814 $marc->leader($ldr);
1816 # Expects the record ID in the 001
1817 $marc->delete_field($_) for ($marc->field('001'));
1818 if (!$marc->field('001')) {
1819 $marc->insert_fields_ordered(
1820 MARC::Field->new( '001', $record->id )
1823 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1824 foreach my $cn (keys %$bib_holdings) {
1825 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1826 $marc->insert_fields_ordered(
1829 a => $cp->{'location'},
1830 b => $bib_holdings->{$cn}->{'owning_lib'},
1832 d => $cp->{'circlib'},
1833 g => $cp->{'barcode'},
1834 n => $cp->{'status'},
1840 # Ensure the data is encoded as UTF8 before we hand it off
1841 $marcxml = encode_utf8($marc->as_xml_record());
1842 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1846 SRU::Response::Record->new(
1847 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1848 recordData => $marcxml,
1849 recordPosition => ++$offset
1854 $resp->numberOfRecords($recs->{count});
1856 } elsif ( $resp->type eq 'explain' ) {
1857 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1858 \%OpenILS::WWW::SuperCat::nested_qualifier_map,
1859 \%OpenILS::WWW::SuperCat::qualifier_ids
1863 SRU::Response::Record->new(
1864 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1865 recordData => $ex_doc
1870 print $cgi->header( -type => 'application/xml' );
1871 print $U->entityize($resp->asXML) . "\n";
1872 return Apache2::Const::OK;
1877 package CQL::BooleanNode;
1881 my $left = $self->left();
1882 my $right = $self->right();
1883 my $leftStr = $left->toEvergreen;
1884 my $rightStr = $right->toEvergreen();
1886 my $op = '||' if uc $self->op() eq 'OR';
1889 return "$leftStr $rightStr";
1892 sub toEvergreenAuth {
1893 return toEvergreen(shift);
1896 package CQL::TermNode;
1900 my $qualifier = $self->getQualifier();
1901 my $term = $self->getTerm();
1902 my $relation = $self->getRelation();
1906 my ($qset, $qname) = split(/\./, $qualifier);
1908 $log->debug("SRU toEvergreen: $qset, $qname $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0]\n");
1910 if ( exists($OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}) ) {
1911 $qualifier = $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0] || 'kw';
1914 my @modifiers = $relation->getModifiers();
1916 my $base = $relation->getBase();
1917 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1920 foreach my $m ( @modifiers ) {
1921 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1927 $quote_it = 0 if ( $base eq 'all' );
1928 $term = maybeQuote($term) if $quote_it;
1931 croak( "Evergreen doesn't support the $base relations" );
1939 return "$qualifier:$term";
1942 sub toEvergreenAuth {
1944 my $qualifier = $self->getQualifier();
1945 my $term = $self->getTerm();
1946 my $relation = $self->getRelation();
1950 my ($qset, $qname) = split(/\./, $qualifier);
1952 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}[0]\n");
1954 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1955 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}[0] || 'author';
1958 return { qualifier => $qualifier, term => $term };
1963 sub sru_auth_search {
1966 my $req = SRU::Request->newFromCGI( $cgi );
1967 my $resp = SRU::Response->newFromRequest( $req );
1969 if ( $resp->type eq 'searchRetrieve' ) {
1970 return_auth_response($cgi, $req, $resp);
1971 } elsif ( $resp->type eq 'explain' ) {
1972 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1973 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1974 \%OpenILS::WWW::SuperCat::qualifier_ids
1978 print $cgi->header( -type => 'application/xml' );
1979 print $U->entityize($resp->asXML) . "\n";
1980 return Apache2::Const::OK;
1983 sub explain_header {
1986 my $host = $cgi->virtual_host || $cgi->server_name;
1989 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1990 my $rel_name = $cgi->url(-relative=>1);
1991 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1993 my $base = $cgi->url(-base=>1);
1994 my $url = $cgi->url(-path_info=>$add_path);
1995 $url =~ s/^$base\///o;
1997 my $doc = $parser->parse_string($base_explain);
1998 my $e = $doc->documentElement;
1999 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2000 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2001 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2006 sub return_sru_explain {
2007 my ($cgi, $req, $resp, $explain, $qualifier_map, $qualifier_ids) = @_;
2010 my ($doc, $e) = explain_header($cgi);
2011 for my $name ( keys %$qualifier_map ) {
2013 my $identifier = $qualifier_ids->{ $name };
2015 next unless $identifier;
2017 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2018 $set_node->setAttribute( identifier => $identifier );
2019 $set_node->setAttribute( name => $name );
2021 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2023 for my $index ( @{$qualifier_map{$name}} ) {
2025 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2027 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2028 $map_node->appendChild( $name_node );
2030 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2032 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2033 $index_node->appendChild( $title_node );
2034 $index_node->appendChild( $map_node );
2036 $index_node->setAttribute( id => "$name.$index" );
2037 $title_node->appendText( $index);
2038 $name_node->setAttribute( set => $name );
2039 $name_node->appendText($index);
2041 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2045 $$explain = $e->toString;
2049 SRU::Response::Record->new(
2050 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2051 recordData => $$explain
2057 sub return_auth_response {
2058 my ($cgi, $req, $resp) = @_;
2060 my $cql_query = decode_utf8($req->query);
2061 my $search = $req->cql->toEvergreenAuth;
2063 my $qualifier = decode_utf8($search->{qualifier});
2064 my $term = decode_utf8($search->{term});
2066 $log->info("SRU NAF search string [$cql_query] converted to "
2067 . "[$qualifier:$term]\n");
2069 my $page_size = $req->maximumRecords;
2072 # startwith deals with pages, so convert startRecord to a page number
2073 my $page = ($req->startRecord / $page_size) || 0;
2076 if ($qualifier eq "id") {
2077 $recs = [ int($term) ];
2079 $recs = $supercat->request(
2080 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2084 my $record_position = $req->startRecord;
2085 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2086 foreach my $record (@$recs) {
2087 my $marcxml = $cstore->request(
2088 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2092 SRU::Response::Record->new(
2093 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2094 recordData => $marcxml,
2095 recordPosition => ++$record_position
2100 $resp->numberOfRecords(scalar(@$recs));
2103 =head2 get_ou($org_unit)
2105 Returns an aou object for a given actor.org_unit shortname or ID.
2110 my $org = shift || '-';
2114 $org_unit = $actor->request(
2115 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2117 } elsif ($org !~ /^\d+$/o) {
2118 $org_unit = $actor->request(
2119 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2122 $org_unit = $actor->request(
2123 'open-ils.actor.org_unit_list.search' => id => $org