1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
5 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
6 use APR::Const -compile => qw(:error SUCCESS);
7 use Apache2::RequestRec ();
8 use Apache2::RequestIO ();
9 use Apache2::RequestUtil;
15 use OpenSRF::EX qw(:try);
16 use OpenSRF::Utils qw/:datetime/;
17 use OpenSRF::Utils::Cache;
19 use OpenSRF::AppSession;
24 use Unicode::Normalize;
25 use OpenILS::Utils::Fieldmapper;
26 use OpenILS::WWW::SuperCat::Feed;
27 use OpenSRF::Utils::Logger qw/$logger/;
28 use OpenILS::Application::AppUtils;
33 my $log = 'OpenSRF::Utils::Logger';
34 my $U = 'OpenILS::Application::AppUtils';
36 # set the bootstrap config when this module is loaded
37 my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
39 $browse_types{call_number}{xml} = sub {
42 my $year = (gmtime())[5] + 1900;
45 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
48 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
49 $cn_class =~ s/Fieldmapper-//gso;
51 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
52 my $cn_lib = $cn->owning_lib->shortname;
53 my $cn_label = $cn->label;
55 $cn_label =~ s/\n//gos;
56 $cn_label =~ s/&/&/go;
57 $cn_label =~ s/'/'/go;
58 $cn_label =~ s/</</go;
59 $cn_label =~ s/>/>/go;
61 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
62 $ou_class =~ s/Fieldmapper-//gso;
64 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
65 my $ou_name = $cn->owning_lib->name;
67 $ou_name =~ s/\n//gos;
68 $ou_name =~ s/'/'/go;
70 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
71 $rec_class =~ s/Fieldmapper-//gso;
73 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
75 $content .= "<volume id='$cn_tag' lib='$cn_lib' label='$cn_label'>\n";
76 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
78 my $r_doc = $parser->parse_string($cn->record->marc);
79 $r_doc->documentElement->setAttribute( id => $rec_tag );
80 $content .= $U->entityize($r_doc->documentElement->toString);
82 $content .= "</volume>\n";
85 $content .= "</volumes>\n";
86 return ("Content-type: application/xml\n\n",$content);
90 $browse_types{call_number}{html} = sub {
95 if (!$cn_browse_xslt) {
96 $cn_browse_xslt = $parser->parse_file(
97 OpenSRF::Utils::SettingsClient
99 ->config_value( dirs => 'xsl' ).
102 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
105 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
108 "Content-type: text/html\n\n",
110 $cn_browse_xslt->transform(
111 $parser->parse_string( $xml ),
126 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
128 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
129 Fieldmapper->import(IDL => $idl);
131 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
132 $actor = OpenSRF::AppSession->create('open-ils.actor');
133 $search = OpenSRF::AppSession->create('open-ils.search');
134 $parser = new XML::LibXML;
135 $xslt = new XML::LibXSLT;
137 $cn_browse_xslt = $parser->parse_file(
138 OpenSRF::Utils::SettingsClient
140 ->config_value( dirs => 'xsl' ).
144 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
146 %qualifier_map = %{$supercat
147 ->request("open-ils.supercat.biblio.search_aliases")
150 my %attribute_desc = (
151 site => 'Evergreen Site Code (shortname)',
152 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
153 dir => 'Sort direction (asc|desc)',
154 available => 'Filter to available (true|false)',
157 # Append the non-search-alias attributes to the qualifier map
174 preferred_language_weight
175 preferred_language_multiplier
177 $qualifier_map{'eg'}{$_}{'index'} = $_;
178 if (exists $attribute_desc{$_}) {
179 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
181 $qualifier_map{'eg'}{$_}{'title'} = $_;
186 ->request("open-ils.supercat.record.formats")
189 $list = [ map { (keys %$_)[0] } @$list ];
190 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
192 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
193 for my $record_browse_format ( @$list ) {
195 my $__f = $record_browse_format;
196 my $__a = $browse_axis;
198 $browse_types{$__a}{$__f} = sub {
199 my $record_list = shift;
202 my $real_format = shift || $__f;
207 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
208 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
209 $feed->root( "$base/../" );
211 $feed->link( next => $next => $feed->type );
212 $feed->link( previous => $prev => $feed->type );
215 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
223 for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
224 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
227 my $__a = $browse_axis;
229 $browse_types{$__a}{$__f} = sub {
230 my $record_list = shift;
233 my $real_format = shift || $__f;
238 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
239 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
240 $feed->root( "$base/../" );
241 $feed->link( next => $next => $feed->type );
242 $feed->link( previous => $prev => $feed->type );
245 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
254 =head2 parse_feed_type($type)
256 Determines whether and how a given feed type needs to be "fleshed out"
257 with holdings information.
259 The feed type could end with the string "-full", in which case we want
260 to return call numbers, copies, and URIS.
262 Or the feed type could be "-uris", in which case we want to return
263 call numbers and URIS.
265 Otherwise, we won't return any holdings.
269 sub parse_feed_type {
272 if ($type =~ /-full$/o) {
276 if ($type =~ /-uris$/o) {
280 # Otherwise, we'll return just the facts, ma'am
284 =head2 supercat_format($format_hashref, $format_type)
286 Given a reference to a hash containing the namespace_uri,
287 docs, and schema location attributes for a set of formats,
288 generate the XML description required by the supercat service.
290 We derive the base type from the format type so that we do not
291 have to populate the hash with redundant information.
295 sub supercat_format {
299 (my $base_type = $type) =~ s/(-full|-uris)$//o;
301 my $format = "<format><name>$type</name><type>application/xml</type>";
303 for my $part ( qw/namespace_uri docs schema_location/ ) {
304 $format .= "<$part>$$h{$base_type}{$part}</$part>"
305 if ($$h{$base_type}{$part});
308 $format .= '</format>';
313 =head2 unapi_format($format_hashref, $format_type)
315 Given a reference to a hash containing the namespace_uri,
316 docs, and schema location attributes for a set of formats,
317 generate the XML description required by the supercat service.
319 We derive the base type from the format type so that we do not
320 have to populate the hash with redundant information.
328 (my $base_type = $type) =~ s/(-full|-uris)$//o;
330 my $format = "<format name='$type' type='application/xml'";
332 for my $part ( qw/namespace_uri docs schema_location/ ) {
333 $format .= " $part='$$h{$base_type}{$part}'"
334 if ($$h{$base_type}{$part});
346 return Apache2::Const::DECLINED if (-e $apache->filename);
348 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
351 ->request("open-ils.supercat.oisbn", $isbn)
354 print "Content-type: application/xml; charset=utf-8\n\n";
355 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
357 unless (exists $$list{metarecord}) {
359 return Apache2::Const::OK;
362 print "<idlist metarecord='$$list{metarecord}'>\n";
364 for ( keys %{ $$list{record_list} } ) {
365 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
366 print " <isbn record='$_'>$o</isbn>\n"
371 return Apache2::Const::OK;
377 return Apache2::Const::DECLINED if (-e $apache->filename);
382 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
383 my $rel_name = $cgi->url(-relative=>1);
384 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
387 my $url = $cgi->url(-path_info=>$add_path);
388 my $root = (split 'unapi', $url)[0];
389 my $base = (split 'unapi', $url)[0] . 'unapi';
392 my $uri = $cgi->param('id') || '';
393 my $host = $cgi->virtual_host || $cgi->server_name;
395 my $skin = $cgi->param('skin') || 'default';
396 my $locale = $cgi->param('locale') || 'en-US';
398 # Enable localized results of copy status, etc
399 $supercat->session_locale($locale);
401 my $format = $cgi->param('format');
402 my $flesh_feed = parse_feed_type($format);
403 (my $base_format = $format) =~ s/(-full|-uris)$//o;
404 my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
407 my $body = "Content-type: application/xml; charset=utf-8\n\n";
409 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
412 ($lib,$depth) = split('/', $4);
414 $type = 'metarecord' if ($1 =~ /^m/o);
415 $type = 'authority' if ($1 =~ /^authority/o);
418 ->request("open-ils.supercat.$type.formats")
421 if ($type eq 'record' or $type eq 'isbn') {
422 $body .= <<" FORMATS";
424 <format name='opac' type='text/html'/>
425 <format name='html' type='text/html'/>
426 <format name='htmlholdings' type='text/html'/>
427 <format name='holdings_xml' type='application/xml'/>
428 <format name='holdings_xml-full' type='application/xml'/>
429 <format name='html-full' type='text/html'/>
430 <format name='htmlholdings-full' type='text/html'/>
431 <format name='marctxt' type='text/plain'/>
432 <format name='ris' type='text/plain'/>
434 } elsif ($type eq 'metarecord') {
435 $body .= <<" FORMATS";
437 <format name='opac' type='text/html'/>
440 $body .= <<" FORMATS";
446 my ($type) = keys %$h;
447 $body .= unapi_format($h, $type);
449 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
450 $body .= unapi_format($h, "$type-full");
451 $body .= unapi_format($h, "$type-uris");
455 $body .= "</formats>\n";
459 ->request("open-ils.supercat.$type.formats")
464 ->request("open-ils.supercat.metarecord.formats")
468 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
469 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
471 $body .= <<" FORMATS";
473 <format name='opac' type='text/html'/>
474 <format name='html' type='text/html'/>
475 <format name='htmlholdings' type='text/html'/>
476 <format name='holdings_xml' type='application/xml'/>
477 <format name='holdings_xml-full' type='application/xml'/>
478 <format name='html-full' type='text/html'/>
479 <format name='htmlholdings-full' type='text/html'/>
480 <format name='marctxt' type='text/plain'/>
481 <format name='ris' type='text/plain'/>
486 my ($type) = keys %$h;
487 $body .= "\t" . unapi_format($h, $type);
489 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
490 $body .= "\t" . unapi_format($h, "$type-full");
491 $body .= "\t" . unapi_format($h, "$type-uris");
495 $body .= "</formats>\n";
499 return Apache2::Const::OK;
503 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
507 ($lib,$depth) = split('/', $4);
509 $type = 'metarecord' if ($scheme =~ /^metabib/o);
510 $type = 'isbn' if ($scheme =~ /^isbn/o);
511 $type = 'acp' if ($scheme =~ /^asset-copy/o);
512 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
513 $type = 'auri' if ($scheme =~ /^asset-uri/o);
514 $type = 'authority' if ($scheme =~ /^authority/o);
515 $command = 'retrieve';
516 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
520 $paging = [split ',', $paging];
525 if (!$lib || $lib eq '-') {
526 $lib = $actor->request(
527 'open-ils.actor.org_unit_list.search' => parent_ou => undef
528 )->gather(1)->[0]->shortname;
531 my ($lib_object,$lib_id,$ou_types,$lib_depth);
532 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
533 $lib_object = $actor->request(
534 'open-ils.actor.org_unit_list.search' => shortname => $lib
536 $lib_id = $lib_object->id;
538 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
539 $lib_depth = $depth || (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
542 if ($command eq 'browse') {
543 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
547 if ($type eq 'isbn') {
548 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
550 print "Content-type: text/html; charset=utf-8\n\n";
551 $apache->custom_response( 404, <<" HTML");
554 <title>Type [$type] with id [$id] not found!</title>
558 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
569 { (keys(%$_))[0] eq $base_format }
570 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
572 { $_ eq $base_format }
573 qw/opac html htmlholdings marctxt ris holdings_xml/
575 print "Content-type: text/html; charset=utf-8\n\n";
576 $apache->custom_response( 406, <<" HTML");
579 <title>Invalid format [$format] for type [$type]!</title>
583 <center>Sorry, format $format is not valid for type $type.</center>
590 if ($format eq 'opac') {
591 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
592 if ($type eq 'metarecord');
593 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
594 if ($type eq 'record');
596 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
597 my $feed = create_record_feed(
608 print "Content-type: text/html; charset=utf-8\n\n";
609 $apache->custom_response( 404, <<" HTML");
612 <title>Type [$type] with id [$id] not found!</title>
616 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
624 $feed->creator($host);
626 $feed->link( unapi => $base) if ($flesh_feed);
628 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
629 print $U->entityize($feed->toString) . "\n";
631 return Apache2::Const::OK;
634 my $method = "open-ils.supercat.$type.$base_format.$command";
636 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
638 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
639 # however, we can have it carry extra options like no_record! (comma separated)
640 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
642 my $req = $supercat->request($method,@params);
643 my $data = $req->gather();
645 if ($req->failed || !$data) {
646 print "Content-type: text/html; charset=utf-8\n\n";
647 $apache->custom_response( 404, <<" HTML");
650 <title>$type $id not found!</title>
654 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
661 print "Content-type: application/xml; charset=utf-8\n\n$data";
663 if ($base_format eq 'holdings_xml') {
664 while (my $c = $req->recv) {
669 return Apache2::Const::OK;
675 return Apache2::Const::DECLINED if (-e $apache->filename);
680 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
681 my $rel_name = $cgi->url(-relative=>1);
682 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
685 my $url = $cgi->url(-path_info=>$add_path);
686 my $root = (split 'supercat', $url)[0];
687 my $base = (split 'supercat', $url)[0] . 'supercat';
688 my $unapi = (split 'supercat', $url)[0] . 'unapi';
690 my $host = $cgi->virtual_host || $cgi->server_name;
692 my $path = $cgi->path_info;
693 my ($id,$type,$format,$command) = reverse split '/', $path;
694 my $flesh_feed = parse_feed_type($format);
695 (my $base_format = $format) =~ s/(-full|-uris)$//o;
697 my $skin = $cgi->param('skin') || 'default';
698 my $locale = $cgi->param('locale') || 'en-US';
700 # Enable localized results of copy status, etc
701 $supercat->session_locale($locale);
703 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
704 print "Content-type: application/xml; charset=utf-8\n";
707 ->request("open-ils.supercat.$1.formats")
715 <type>text/html</type>
718 if ($1 eq 'record' or $1 eq 'isbn') {
720 <name>htmlholdings</name>
721 <type>text/html</type>
725 <type>text/html</type>
728 <name>htmlholdings-full</name>
729 <type>text/html</type>
732 <name>html-full</name>
733 <type>text/html</type>
737 <type>text/plain</type>
741 <type>text/plain</type>
746 my ($type) = keys %$h;
747 print supercat_format($h, $type);
749 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
750 print supercat_format($h, "$type-full");
751 print supercat_format($h, "$type-uris");
756 print "</formats>\n";
758 return Apache2::Const::OK;
762 ->request("open-ils.supercat.record.formats")
767 ->request("open-ils.supercat.metarecord.formats")
771 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
772 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
777 <type>text/html</type>
780 <name>htmlholdings</name>
781 <type>text/html</type>
785 <type>text/html</type>
788 <name>htmlholdings-full</name>
789 <type>text/html</type>
792 <name>html-full</name>
793 <type>text/html</type>
797 <type>text/plain</type>
801 <type>text/plain</type>
805 my ($type) = keys %$h;
806 print supercat_format($h, $type);
808 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
809 print supercat_format($h, "$type-full");
810 print supercat_format($h, "$type-uris");
815 print "</formats>\n";
818 return Apache2::Const::OK;
821 if ($format eq 'opac') {
822 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
823 if ($type eq 'metarecord');
824 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
825 if ($type eq 'record');
828 } elsif ($base_format eq 'marc21') {
832 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
834 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
839 print "Content-type: text/html; charset=utf-8\n\n";
840 $apache->custom_response( 404, <<" HTML");
847 <center>Couldn't fetch $id as MARC21.</center>
854 return Apache2::Const::OK;
856 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
857 my $feed = create_record_feed(
865 $feed->creator($host);
869 $feed->link( unapi => $base) if ($flesh_feed);
871 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
872 print $U->entityize($feed->toString) . "\n";
874 return Apache2::Const::OK;
877 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
881 print "Content-type: text/html; charset=utf-8\n\n";
882 $apache->custom_response( 404, <<" HTML");
885 <title>$type $id not found!</title>
889 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
896 print "Content-type: application/xml; charset=utf-8\n\n";
897 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
899 return Apache2::Const::OK;
905 return Apache2::Const::DECLINED if (-e $apache->filename);
909 my $year = (gmtime())[5] + 1900;
910 my $host = $cgi->virtual_host || $cgi->server_name;
913 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
914 my $rel_name = $cgi->url(-relative=>1);
915 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
918 my $url = $cgi->url(-path_info=>$add_path);
919 my $root = (split 'feed', $url)[0] . '/';
920 my $base = (split 'bookbag', $url)[0] . '/bookbag';
921 my $unapi = (split 'feed', $url)[0] . '/unapi';
923 my $skin = $cgi->param('skin') || 'default';
924 my $locale = $cgi->param('locale') || 'en-US';
925 my $org = $cgi->param('searchOrg');
927 # Enable localized results of copy status, etc
928 $supercat->session_locale($locale);
930 my $org_unit = get_ou($org);
931 my $scope = "l=" . $org_unit->[0]->id . "&";
933 $root =~ s{(?<!http:)//}{/}go;
934 $base =~ s{(?<!http:)//}{/}go;
935 $unapi =~ s{(?<!http:)//}{/}go;
937 my $path = $cgi->path_info;
938 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
940 my ($id,$type) = reverse split '/', $path;
941 my $flesh_feed = parse_feed_type($type);
943 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
944 return Apache2::Const::NOT_FOUND unless($bucket);
946 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
947 if ($type eq 'opac') {
948 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
949 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
954 my $feed = create_record_feed(
957 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
959 $org_unit->[0]->shortname,
964 $feed->id($bucket_tag);
966 $feed->title("Items in Book Bag [".$bucket->name."]");
967 $feed->creator($host);
970 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
971 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
972 $feed->link(html => $base . "/html-full/$id" => 'text/html');
973 $feed->link(unapi => $unapi);
977 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
978 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
983 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
984 print $U->entityize($feed->toString) . "\n";
986 return Apache2::Const::OK;
991 return Apache2::Const::DECLINED if (-e $apache->filename);
995 my $year = (gmtime())[5] + 1900;
996 my $host = $cgi->virtual_host || $cgi->server_name;
999 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1000 my $rel_name = $cgi->url(-relative=>1);
1001 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1004 my $url = $cgi->url(-path_info=>$add_path);
1005 my $root = (split 'feed', $url)[0];
1006 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1007 my $unapi = (split 'feed', $url)[0] . 'unapi';
1009 my $skin = $cgi->param('skin') || 'default';
1010 my $locale = $cgi->param('locale') || 'en-US';
1011 my $org = $cgi->param('searchOrg');
1013 # Enable localized results of copy status, etc
1014 $supercat->session_locale($locale);
1016 my $org_unit = get_ou($org);
1017 my $scope = "l=" . $org_unit->[0]->id . "&";
1019 my $path = $cgi->path_info;
1020 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1022 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1024 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1025 my $flesh_feed = parse_feed_type($type);
1028 $limit = 10 if $limit !~ /^\d+$/;
1030 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1032 #if ($type eq 'opac') {
1033 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1034 # join('&', map { "rl=" . $_ } @$list) .
1039 my $search = 'record';
1040 if ($rtype eq 'authority') {
1041 $search = 'authority';
1043 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1047 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1049 $feed->title("$limit most recent $rtype ${axis}s");
1052 $feed->creator($host);
1055 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1056 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1057 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1058 $feed->link(unapi => $unapi);
1062 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1063 join('&', map { 'rl=' . $_} @$list ),
1068 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1069 print $U->entityize($feed->toString) . "\n";
1071 return Apache2::Const::OK;
1074 sub opensearch_osd {
1075 my $version = shift;
1080 if ($version eq '1.0') {
1082 Content-type: application/opensearchdescription+xml; charset=utf-8
1084 <?xml version="1.0" encoding="UTF-8"?>
1085 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1086 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1087 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1088 <ShortName>$lib</ShortName>
1089 <LongName>Search $lib</LongName>
1090 <Description>Search the $lib OPAC by $class.</Description>
1091 <Tags>$lib book library</Tags>
1092 <SampleSearch>harry+potter</SampleSearch>
1093 <Developer>Mike Rylander for GPLS/PINES</Developer>
1094 <Contact>feedback\@open-ils.org</Contact>
1095 <SyndicationRight>open</SyndicationRight>
1096 <AdultContent>false</AdultContent>
1097 </OpenSearchDescription>
1101 Content-type: application/opensearchdescription+xml; charset=utf-8
1103 <?xml version="1.0" encoding="UTF-8"?>
1104 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1105 <ShortName>$lib</ShortName>
1106 <Description>Search the $lib OPAC by $class.</Description>
1107 <Tags>$lib book library</Tags>
1108 <Url type="application/rss+xml"
1109 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1110 <Url type="application/atom+xml"
1111 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1112 <Url type="application/x-mods3+xml"
1113 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1114 <Url type="application/x-mods+xml"
1115 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1116 <Url type="application/x-marcxml+xml"
1117 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1118 <Url type="text/html"
1119 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1120 <LongName>Search $lib</LongName>
1121 <Query role="example" searchTerms="harry+potter" />
1122 <Developer>Mike Rylander for GPLS/PINES</Developer>
1123 <Contact>feedback\@open-ils.org</Contact>
1124 <SyndicationRight>open</SyndicationRight>
1125 <AdultContent>false</AdultContent>
1126 <Language>en-US</Language>
1127 <OutputEncoding>UTF-8</OutputEncoding>
1128 <InputEncoding>UTF-8</InputEncoding>
1129 </OpenSearchDescription>
1133 return Apache2::Const::OK;
1136 sub opensearch_feed {
1138 return Apache2::Const::DECLINED if (-e $apache->filename);
1141 my $year = (gmtime())[5] + 1900;
1143 my $host = $cgi->virtual_host || $cgi->server_name;
1146 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1147 my $rel_name = $cgi->url(-relative=>1);
1148 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1151 my $url = $cgi->url(-path_info=>$add_path);
1152 my $root = (split 'opensearch', $url)[0];
1153 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1154 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1156 my $path = $cgi->path_info;
1157 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1159 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1165 if (!$lib || $lib eq '-') {
1166 $lib = $actor->request(
1167 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1168 )->gather(1)->[0]->shortname;
1171 if ($class eq '-') {
1175 return opensearch_osd($version, $lib, $class, $base);
1179 my $page = $cgi->param('startPage') || 1;
1180 my $offset = $cgi->param('startIndex') || 1;
1181 my $limit = $cgi->param('count') || 10;
1183 $page = 1 if ($page !~ /^\d+$/);
1184 $offset = 1 if ($offset !~ /^\d+$/);
1185 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1188 $offset = ($page - 1) * $limit;
1193 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1194 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1196 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1197 $lang = '' if ($lang eq '*');
1199 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1201 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1204 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1205 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1207 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1210 $type = $cgi->param('responseType') if $cgi->param('responseType');
1213 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1217 my $kwt = $cgi->param('kw');
1218 my $tit = $cgi->param('ti');
1219 my $aut = $cgi->param('au');
1220 my $sut = $cgi->param('su');
1221 my $set = $cgi->param('se');
1223 $terms .= " " if ($terms && $kwt);
1224 $terms .= "keyword: $kwt" if ($kwt);
1225 $terms .= " " if ($terms && $tit);
1226 $terms .= "title: $tit" if ($tit);
1227 $terms .= " " if ($terms && $aut);
1228 $terms .= "author: $aut" if ($aut);
1229 $terms .= " " if ($terms && $sut);
1230 $terms .= "subject: $sut" if ($sut);
1231 $terms .= " " if ($terms && $set);
1232 $terms .= "series: $set" if ($set);
1234 if ($version eq '1.0') {
1236 } elsif ($type eq '-') {
1239 my $flesh_feed = parse_feed_type($type);
1241 $terms = decode_utf8($terms);
1242 $lang = 'eng' if ($lang eq 'en-US');
1244 $log->debug("OpenSearch terms: $terms");
1246 my $org_unit = get_ou($org);
1248 # Apostrophes break search and get indexed as spaces anyway
1249 my $safe_terms = $terms;
1250 $safe_terms =~ s{'}{ }go;
1252 my $recs = $search->request(
1253 'open-ils.search.biblio.multiclass.query' => {
1254 org_unit => $org_unit->[0]->id,
1258 sort_dir => $sortdir,
1259 default_class => $class,
1260 ($lang ? ( 'language' => $lang ) : ()),
1261 } => $safe_terms => 1
1264 $log->debug("Hits for [$terms]: $recs->{count}");
1266 my $feed = create_record_feed(
1269 [ map { $_->[0] } @{$recs->{ids}} ],
1276 $log->debug("Feed created...");
1280 $feed->search($safe_terms);
1281 $feed->class($class);
1283 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1285 $feed->creator($host);
1288 $feed->_create_node(
1289 $feed->{item_xpath},
1290 'http://a9.com/-/spec/opensearch/1.1/',
1295 $feed->_create_node(
1296 $feed->{item_xpath},
1297 'http://a9.com/-/spec/opensearch/1.1/',
1302 $feed->_create_node(
1303 $feed->{item_xpath},
1304 'http://a9.com/-/spec/opensearch/1.1/',
1309 $log->debug("...basic feed data added...");
1313 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1314 'application/opensearch+xml'
1315 ) if ($offset + $limit < $recs->{count});
1319 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1320 'application/opensearch+xml'
1325 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1326 'application/opensearch+xml'
1331 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1332 'application/rss+xml'
1337 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1338 'application/atom+xml'
1343 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1349 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1353 $feed->link( 'unapi-server' => $unapi);
1355 $log->debug("...feed links added...");
1359 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1360 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1364 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1365 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1367 $log->debug("...and feed returned.");
1369 return Apache2::Const::OK;
1372 sub create_record_feed {
1375 my $records = shift;
1378 my $lib = uc(shift()) || '-';
1385 my $base = $cgi->url;
1386 my $host = $cgi->virtual_host || $cgi->server_name;
1388 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1392 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1394 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1396 $type =~ s/(-full|-uris)$//o;
1398 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1399 $feed->base($base) if ($flesh);
1400 $feed->unapi($unapi) if ($flesh);
1402 $type = 'atom' if ($type eq 'html');
1403 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1405 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1408 for my $record (@$records) {
1409 next unless($record);
1411 #my $rec = $record->id;
1414 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1415 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1416 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1417 $item_tag .= "/$depth" if (defined($depth));
1419 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1421 my $xml = $supercat->request(
1422 "open-ils.supercat.$search.$type.retrieve",
1427 my $node = $feed->add_item($xml);
1431 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && $flesh > 0) {
1432 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1433 while ( !$r->complete ) {
1434 $xml .= join('', map {$_->content} $r->recv);
1436 $xml .= join('', map {$_->content} $r->recv);
1437 $node->add_holdings($xml);
1440 $node->id($item_tag);
1441 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1442 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1443 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1444 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1445 $node->link('unapi-id' => $item_tag) if ($flesh);
1453 return Apache2::Const::DECLINED if (-e $apache->filename);
1456 my $year = (gmtime())[5] + 1900;
1458 my $host = $cgi->virtual_host || $cgi->server_name;
1461 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1462 my $rel_name = $cgi->url(-relative=>1);
1463 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1466 my $url = $cgi->url(-path_info=>$add_path);
1467 my $root = (split 'browse', $url)[0];
1468 my $base = (split 'browse', $url)[0] . 'browse';
1469 my $unapi = (split 'browse', $url)[0] . 'unapi';
1471 my $path = $cgi->path_info;
1474 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1475 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1477 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1479 my $status = [$cgi->param('status')];
1480 my $cpLoc = [$cgi->param('copyLocation')];
1481 $site ||= $cgi->param('searchOrg');
1482 $page ||= $cgi->param('startPage') || 0;
1483 $page_size ||= $cgi->param('count') || 9;
1485 $page = 0 if ($page !~ /^-?\d+$/);
1486 $page_size = 9 if $page_size !~ /^\d+$/;
1488 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1489 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1491 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1492 warn "something's wrong...";
1493 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1497 $string = decode_utf8($string);
1498 $string =~ s/\+/ /go;
1501 my $tree = $supercat->request(
1502 "open-ils.supercat.$axis.browse",
1504 (($axis =~ /^authority/) ? () : ($site)),
1511 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1513 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1514 print $header.$content;
1515 return Apache2::Const::OK;
1518 sub string_startwith {
1520 return Apache2::Const::DECLINED if (-e $apache->filename);
1523 my $year = (gmtime())[5] + 1900;
1525 my $host = $cgi->virtual_host || $cgi->server_name;
1528 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1529 my $rel_name = $cgi->url(-relative=>1);
1530 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1533 my $url = $cgi->url(-path_info=>$add_path);
1534 my $root = (split 'startwith', $url)[0];
1535 my $base = (split 'startwith', $url)[0] . 'startwith';
1536 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1538 my $path = $cgi->path_info;
1541 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1542 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1544 my $status = [$cgi->param('status')];
1545 my $cpLoc = [$cgi->param('copyLocation')];
1546 $site ||= $cgi->param('searchOrg');
1547 $page ||= $cgi->param('startPage') || 0;
1548 $page_size ||= $cgi->param('count') || 9;
1550 $page = 0 if ($page !~ /^-?\d+$/);
1551 $page_size = 9 if $page_size !~ /^\d+$/;
1553 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1554 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1556 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1557 warn "something's wrong...";
1558 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1562 $string = decode_utf8($string);
1563 $string =~ s/\+/ /go;
1566 my $tree = $supercat->request(
1567 "open-ils.supercat.$axis.startwith",
1569 (($axis =~ /^authority/) ? () : ($site)),
1576 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1578 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1579 print $header.$content;
1580 return Apache2::Const::OK;
1583 sub item_age_browse {
1585 return Apache2::Const::DECLINED if (-e $apache->filename);
1588 my $year = (gmtime())[5] + 1900;
1590 my $host = $cgi->virtual_host || $cgi->server_name;
1593 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1594 my $rel_name = $cgi->url(-relative=>1);
1595 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1598 my $url = $cgi->url(-path_info=>$add_path);
1599 my $root = (split 'browse', $url)[0];
1600 my $base = (split 'browse', $url)[0] . 'browse';
1601 my $unapi = (split 'browse', $url)[0] . 'unapi';
1603 my $path = $cgi->path_info;
1606 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1607 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1609 unless ($axis eq 'item-age') {
1610 warn "something's wrong...";
1611 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1615 my $status = [$cgi->param('status')];
1616 my $cpLoc = [$cgi->param('copyLocation')];
1617 $site ||= $cgi->param('searchOrg') || '-';
1618 $page ||= $cgi->param('startPage') || 1;
1619 $page_size ||= $cgi->param('count') || 10;
1621 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1622 $page_size = 10 if $page_size !~ /^\d+$/;
1624 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1625 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1627 my $recs = $supercat->request(
1628 "open-ils.supercat.new_book_list",
1636 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1638 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1639 print $header.$content;
1640 return Apache2::Const::OK;
1643 our %qualifier_ids = (
1644 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1645 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1646 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1650 # Our authority search options are currently pretty impoverished;
1651 # just right-truncated string match on a few categories, or by
1653 our %nested_auth_qualifier_map = (
1655 id => { index => 'id', title => 'Record number'},
1656 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1657 title => { index => 'title', title => 'Uniform title'},
1658 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1659 topic => { index => 'topic', title => 'Topical term'},
1663 my $base_explain = <<XML;
1665 id="evergreen-sru-explain-full"
1666 authoritative="true"
1667 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1668 xmlns="http://explain.z3950.org/dtd/2.0/">
1669 <serverInfo transport="http" protocol="SRU" version="1.1">
1676 <title primary="true"/>
1677 <description primary="true"/>
1681 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1686 identifier="info:srw/schema/1/marcxml-v1.1"
1687 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1691 <title>MARC21Slim (marcxml)</title>
1696 <default type="numberOfRecords">10</default>
1697 <default type="contextSet">eg</default>
1698 <default type="index">keyword</default>
1699 <default type="relation">all</default>
1700 <default type="sortSchema">marcxml</default>
1701 <default type="retrieveSchema">marcxml</default>
1702 <setting type="maximumRecords">50</setting>
1703 <supports type="relationModifier">relevant</supports>
1704 <supports type="relationModifier">stem</supports>
1705 <supports type="relationModifier">fuzzy</supports>
1706 <supports type="relationModifier">word</supports>
1717 my $req = SRU::Request->newFromCGI( $cgi );
1718 my $resp = SRU::Response->newFromRequest( $req );
1720 # Find the org_unit shortname, if passed as part of the URL
1721 # http://example.com/opac/extras/sru/SHORTNAME
1722 my $url = $cgi->path_info;
1723 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1725 if ( $resp->type eq 'searchRetrieve' ) {
1727 # Older versions of Debian packages returned terms to us double-encoded,
1728 # so we had to forcefully double-decode them a second time with
1729 # an outer decode('utf8', $string) call; this seems to be resolved with
1730 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1731 my $cql_query = decode_utf8($req->query);
1732 my $search_string = decode_utf8($req->cql->toEvergreen);
1734 # Ensure the search string overrides the default site
1735 if ($shortname and $search_string !~ m#site:#) {
1736 $search_string .= " site:$shortname";
1739 my $offset = $req->startRecord;
1740 $offset-- if ($offset);
1743 my $limit = $req->maximumRecords;
1746 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1748 my $recs = $search->request(
1749 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1752 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1754 foreach my $record (@$bre) {
1755 my $marcxml = $record->marc;
1756 # Make the beast conform to a VDX-supported format
1757 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1758 # Trying to implement LIBSOL_852_A format; so much for standards
1760 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1761 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1763 # Force record leader to 'a' as our data is always UTF8
1764 # Avoids marc8_to_utf8 from being invoked with horrible results
1765 # on the off-chance the record leader isn't correct
1766 my $ldr = $marc->leader;
1767 substr($ldr, 9, 1, 'a');
1768 $marc->leader($ldr);
1770 # Expects the record ID in the 001
1771 $marc->delete_field($_) for ($marc->field('001'));
1772 if (!$marc->field('001')) {
1773 $marc->insert_fields_ordered(
1774 MARC::Field->new( '001', $record->id )
1777 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1778 foreach my $cn (keys %$bib_holdings) {
1779 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1780 $marc->insert_fields_ordered(
1783 a => $cp->{'location'},
1784 b => $bib_holdings->{$cn}->{'owning_lib'},
1786 d => $cp->{'circlib'},
1787 g => $cp->{'barcode'},
1788 n => $cp->{'status'},
1794 # Ensure the data is encoded as UTF8 before we hand it off
1795 $marcxml = encode_utf8($marc->as_xml_record());
1796 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1800 SRU::Response::Record->new(
1801 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1802 recordData => $marcxml,
1803 recordPosition => ++$offset
1808 $resp->numberOfRecords($recs->{count});
1810 } elsif ( $resp->type eq 'explain' ) {
1811 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1813 \%OpenILS::WWW::SuperCat::qualifier_ids
1817 SRU::Response::Record->new(
1818 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1819 recordData => $ex_doc
1824 print $cgi->header( -type => 'application/xml' );
1825 print $U->entityize($resp->asXML) . "\n";
1826 return Apache2::Const::OK;
1831 package CQL::BooleanNode;
1835 my $left = $self->left();
1836 my $right = $self->right();
1837 my $leftStr = $left->toEvergreen;
1838 my $rightStr = $right->toEvergreen();
1840 my $op = '||' if uc $self->op() eq 'OR';
1843 return "$leftStr $rightStr";
1846 sub toEvergreenAuth {
1847 return toEvergreen(shift);
1850 package CQL::TermNode;
1854 my $qualifier = $self->getQualifier();
1855 my $term = $self->getTerm();
1856 my $relation = $self->getRelation();
1860 my ($qset, $qname) = split(/\./, $qualifier);
1862 if ( exists($qualifier_map{$qset}{$qname}) ) {
1863 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1864 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1867 my @modifiers = $relation->getModifiers();
1869 my $base = $relation->getBase();
1870 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1873 foreach my $m ( @modifiers ) {
1874 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1880 $quote_it = 0 if ( $base eq 'all' );
1881 $term = maybeQuote($term) if $quote_it;
1884 croak( "Evergreen doesn't support the $base relations" );
1892 return "$qualifier:$term";
1895 sub toEvergreenAuth {
1897 my $qualifier = $self->getQualifier();
1898 my $term = $self->getTerm();
1899 my $relation = $self->getRelation();
1903 my ($qset, $qname) = split(/\./, $qualifier);
1905 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1906 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1907 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1910 return { qualifier => $qualifier, term => $term };
1915 sub sru_auth_search {
1918 my $req = SRU::Request->newFromCGI( $cgi );
1919 my $resp = SRU::Response->newFromRequest( $req );
1921 if ( $resp->type eq 'searchRetrieve' ) {
1922 return_auth_response($cgi, $req, $resp);
1923 } elsif ( $resp->type eq 'explain' ) {
1924 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1925 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1926 \%OpenILS::WWW::SuperCat::qualifier_ids
1930 print $cgi->header( -type => 'application/xml' );
1931 print $U->entityize($resp->asXML) . "\n";
1932 return Apache2::Const::OK;
1935 sub explain_header {
1938 my $host = $cgi->virtual_host || $cgi->server_name;
1941 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1942 my $rel_name = $cgi->url(-relative=>1);
1943 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1945 my $base = $cgi->url(-base=>1);
1946 my $url = $cgi->url(-path_info=>$add_path);
1947 $url =~ s/^$base\///o;
1949 my $doc = $parser->parse_string($base_explain);
1950 my $e = $doc->documentElement;
1951 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1952 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1953 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1958 sub return_sru_explain {
1959 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
1961 $index_map ||= \%qualifier_map;
1963 my ($doc, $e) = explain_header($cgi);
1964 for my $name ( keys %{$index_map} ) {
1966 my $identifier = $qualifier_ids->{ $name };
1968 next unless $identifier;
1970 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
1971 $set_node->setAttribute( identifier => $identifier );
1972 $set_node->setAttribute( name => $name );
1974 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
1975 for my $index ( sort keys %{$index_map->{$name}} ) {
1976 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
1978 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
1979 $map_node->appendChild( $name_node );
1981 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
1983 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
1984 $index_node->appendChild( $title_node );
1985 $index_node->appendChild( $map_node );
1987 $index_node->setAttribute( id => "$name.$index" );
1988 $title_node->appendText($index_map->{$name}{$index}{'title'});
1989 $name_node->setAttribute( set => $name );
1990 $name_node->appendText($index_map->{$name}{$index}{'index'});
1992 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
1996 $$explain = $e->toString;
2000 SRU::Response::Record->new(
2001 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2002 recordData => $$explain
2008 sub return_auth_response {
2009 my ($cgi, $req, $resp) = @_;
2011 my $cql_query = decode_utf8($req->query);
2012 my $search = $req->cql->toEvergreenAuth;
2014 my $qualifier = decode_utf8($search->{qualifier});
2015 my $term = decode_utf8($search->{term});
2017 $log->info("SRU NAF search string [$cql_query] converted to "
2018 . "[$qualifier:$term]\n");
2020 my $page_size = $req->maximumRecords;
2023 # startwith deals with pages, so convert startRecord to a page number
2024 my $page = ($req->startRecord / $page_size) || 0;
2027 if ($qualifier eq "id") {
2028 $recs = [ int($term) ];
2030 $recs = $supercat->request(
2031 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2035 my $record_position = $req->startRecord;
2036 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2037 foreach my $record (@$recs) {
2038 my $marcxml = $cstore->request(
2039 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2043 SRU::Response::Record->new(
2044 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2045 recordData => $marcxml,
2046 recordPosition => ++$record_position
2051 $resp->numberOfRecords(scalar(@$recs));
2054 =head2 get_ou($org_unit)
2056 Returns an aou object for a given actor.org_unit shortname or ID.
2061 my $org = shift || '-';
2065 $org_unit = $actor->request(
2066 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2068 } elsif ($org !~ /^\d+$/o) {
2069 $org_unit = $actor->request(
2070 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2073 $org_unit = $actor->request(
2074 'open-ils.actor.org_unit_list.search' => id => $org