1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
5 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
6 use APR::Const -compile => qw(:error SUCCESS);
7 use Apache2::RequestRec ();
8 use Apache2::RequestIO ();
9 use Apache2::RequestUtil;
15 use OpenSRF::EX qw(:try);
16 use OpenSRF::Utils qw/:datetime/;
17 use OpenSRF::Utils::Cache;
19 use OpenSRF::AppSession;
24 use Unicode::Normalize;
25 use OpenILS::Utils::Fieldmapper;
26 use OpenILS::WWW::SuperCat::Feed;
27 use OpenSRF::Utils::Logger qw/$logger/;
28 use OpenILS::Application::AppUtils;
31 use MARC::File::XML ( BinaryEncoding => 'UTF-8' );
33 my $log = 'OpenSRF::Utils::Logger';
34 my $U = 'OpenILS::Application::AppUtils';
36 # set the bootstrap config when this module is loaded
37 my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types, %qualifier_map);
39 $browse_types{call_number}{xml} = sub {
42 my $year = (gmtime())[5] + 1900;
45 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
48 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
49 $cn_class =~ s/Fieldmapper-//gso;
51 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
52 my $cn_lib = $cn->owning_lib->shortname;
53 my $cn_label = $cn->label;
54 my $cn_prefix = $cn->prefix->label;
55 my $cn_suffix = $cn->suffix->label;
57 $cn_label =~ s/\n//gos;
58 $cn_label =~ s/&/&/go;
59 $cn_label =~ s/'/'/go;
60 $cn_label =~ s/</</go;
61 $cn_label =~ s/>/>/go;
63 $cn_prefix =~ s/\n//gos;
64 $cn_prefix =~ s/&/&/go;
65 $cn_prefix =~ s/'/'/go;
66 $cn_prefix =~ s/</</go;
67 $cn_prefix =~ s/>/>/go;
69 $cn_suffix =~ s/\n//gos;
70 $cn_suffix =~ s/&/&/go;
71 $cn_suffix =~ s/'/'/go;
72 $cn_suffix =~ s/</</go;
73 $cn_suffix =~ s/>/>/go;
75 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
76 $ou_class =~ s/Fieldmapper-//gso;
78 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
79 my $ou_name = $cn->owning_lib->name;
81 $ou_name =~ s/\n//gos;
82 $ou_name =~ s/'/'/go;
84 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
85 $rec_class =~ s/Fieldmapper-//gso;
87 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
89 $content .= "<volume id='$cn_tag' lib='$cn_lib' prefix='$cn_prefix' label='$cn_label' suffix='$cn_suffix'>\n";
90 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
92 my $r_doc = $parser->parse_string($cn->record->marc);
93 $r_doc->documentElement->setAttribute( id => $rec_tag );
94 $content .= $U->entityize($r_doc->documentElement->toString);
96 $content .= "</volume>\n";
99 $content .= "</volumes>\n";
100 return ("Content-type: application/xml\n\n",$content);
104 $browse_types{call_number}{html} = sub {
109 if (!$cn_browse_xslt) {
110 $cn_browse_xslt = $parser->parse_file(
111 OpenSRF::Utils::SettingsClient
113 ->config_value( dirs => 'xsl' ).
116 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
119 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
122 "Content-type: text/html\n\n",
124 $cn_browse_xslt->transform(
125 $parser->parse_string( $xml ),
140 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
142 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
143 Fieldmapper->import(IDL => $idl);
145 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
146 $actor = OpenSRF::AppSession->create('open-ils.actor');
147 $search = OpenSRF::AppSession->create('open-ils.search');
148 $parser = new XML::LibXML;
149 $xslt = new XML::LibXSLT;
151 $cn_browse_xslt = $parser->parse_file(
152 OpenSRF::Utils::SettingsClient
154 ->config_value( dirs => 'xsl' ).
158 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
160 %qualifier_map = %{$supercat
161 ->request("open-ils.supercat.biblio.search_aliases")
164 my %attribute_desc = (
165 site => 'Evergreen Site Code (shortname)',
166 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
167 dir => 'Sort direction (asc|desc)',
168 available => 'Filter to available (true|false)',
171 # Append the non-search-alias attributes to the qualifier map
188 preferred_language_weight
189 preferred_language_multiplier
191 $qualifier_map{'eg'}{$_}{'index'} = $_;
192 if (exists $attribute_desc{$_}) {
193 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
195 $qualifier_map{'eg'}{$_}{'title'} = $_;
200 ->request("open-ils.supercat.record.formats")
203 $list = [ map { (keys %$_)[0] } @$list ];
204 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
206 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
207 for my $record_browse_format ( @$list ) {
209 my $__f = $record_browse_format;
210 my $__a = $browse_axis;
212 $browse_types{$__a}{$__f} = sub {
213 my $record_list = shift;
216 my $real_format = shift || $__f;
221 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
222 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
223 $feed->root( "$base/../" );
225 $feed->link( next => $next => $feed->type );
226 $feed->link( previous => $prev => $feed->type );
229 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
237 for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
238 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
241 my $__a = $browse_axis;
243 $browse_types{$__a}{$__f} = sub {
244 my $record_list = shift;
247 my $real_format = shift || $__f;
252 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
253 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
254 $feed->root( "$base/../" );
255 $feed->link( next => $next => $feed->type );
256 $feed->link( previous => $prev => $feed->type );
259 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
268 =head2 parse_feed_type($type)
270 Determines whether and how a given feed type needs to be "fleshed out"
271 with holdings information.
273 The feed type could end with the string "-full", in which case we want
274 to return call numbers, copies, and URIS.
276 Or the feed type could end with "-uris", in which case we want to return
277 call numbers and URIS.
279 Otherwise, we won't return any holdings.
283 sub parse_feed_type {
284 my $type = shift || '';
286 if ($type =~ /-full$/o) {
290 if ($type =~ /-uris$/o) {
294 # Otherwise, we'll return just the facts, ma'am
298 =head2 supercat_format($format_hashref, $format_type)
300 Given a reference to a hash containing the namespace_uri,
301 docs, and schema location attributes for a set of formats,
302 generate the XML description required by the supercat service.
304 We derive the base type from the format type so that we do not
305 have to populate the hash with redundant information.
309 sub supercat_format {
313 (my $base_type = $type) =~ s/(-full|-uris)$//o;
315 my $format = "<format><name>$type</name><type>application/xml</type>";
317 for my $part ( qw/namespace_uri docs schema_location/ ) {
318 $format .= "<$part>$$h{$base_type}{$part}</$part>"
319 if ($$h{$base_type}{$part});
322 $format .= '</format>';
327 =head2 unapi_format($format_hashref, $format_type)
329 Given a reference to a hash containing the namespace_uri,
330 docs, and schema location attributes for a set of formats,
331 generate the XML description required by the supercat service.
333 We derive the base type from the format type so that we do not
334 have to populate the hash with redundant information.
342 (my $base_type = $type) =~ s/(-full|-uris)$//o;
344 my $format = "<format name='$type' type='application/xml'";
346 for my $part ( qw/namespace_uri docs schema_location/ ) {
347 $format .= " $part='$$h{$base_type}{$part}'"
348 if ($$h{$base_type}{$part});
360 return Apache2::Const::DECLINED if (-e $apache->filename);
362 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
365 ->request("open-ils.supercat.oisbn", $isbn)
368 print "Content-type: application/xml; charset=utf-8\n\n";
369 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
371 unless (exists $$list{metarecord}) {
373 return Apache2::Const::OK;
376 print "<idlist metarecord='$$list{metarecord}'>\n";
378 for ( keys %{ $$list{record_list} } ) {
379 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
380 print " <isbn record='$_'>$o</isbn>\n"
385 return Apache2::Const::OK;
391 return Apache2::Const::DECLINED if (-e $apache->filename);
396 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
397 my $rel_name = $cgi->url(-relative=>1);
398 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
401 my $url = $cgi->url(-path_info=>$add_path);
402 my $root = (split 'unapi', $url)[0];
403 my $base = (split 'unapi', $url)[0] . 'unapi';
406 my $uri = $cgi->param('id') || '';
407 my $host = $cgi->virtual_host || $cgi->server_name;
409 my $skin = $cgi->param('skin') || 'default';
410 my $locale = $cgi->param('locale') || 'en-US';
412 # Enable localized results of copy status, etc
413 $supercat->session_locale($locale);
415 my $format = $cgi->param('format') || '';
416 my $flesh_feed = parse_feed_type($format);
417 (my $base_format = $format) =~ s/(-full|-uris)$//o;
418 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
419 my $body = "Content-type: application/xml; charset=utf-8\n\n";
421 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
424 ($lib,$depth) = split('/', $4);
425 $type = 'metarecord' if ($1 =~ /^m/o);
426 $type = 'authority' if ($1 =~ /^authority/o);
430 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
433 ->request("open-ils.supercat.$type.formats")
436 if ($type eq 'record' or $type eq 'isbn') {
437 $body .= <<" FORMATS";
439 <format name='opac' type='text/html'/>
440 <format name='html' type='text/html'/>
441 <format name='htmlholdings' type='text/html'/>
442 <format name='holdings_xml' type='application/xml'/>
443 <format name='holdings_xml-full' type='application/xml'/>
444 <format name='html-full' type='text/html'/>
445 <format name='htmlholdings-full' type='text/html'/>
446 <format name='marctxt' type='text/plain'/>
447 <format name='ris' type='text/plain'/>
449 } elsif ($type eq 'metarecord') {
450 $body .= <<" FORMATS";
452 <format name='opac' type='text/html'/>
455 $body .= <<" FORMATS";
461 my ($type) = keys %$h;
462 $body .= unapi_format($h, $type);
464 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
465 $body .= unapi_format($h, "$type-full");
466 $body .= unapi_format($h, "$type-uris");
470 $body .= "</formats>\n";
474 ->request("open-ils.supercat.$type.formats")
479 ->request("open-ils.supercat.metarecord.formats")
483 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
484 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
486 $body .= <<" FORMATS";
488 <format name='opac' type='text/html'/>
489 <format name='html' type='text/html'/>
490 <format name='htmlholdings' type='text/html'/>
491 <format name='holdings_xml' type='application/xml'/>
492 <format name='holdings_xml-full' type='application/xml'/>
493 <format name='html-full' type='text/html'/>
494 <format name='htmlholdings-full' type='text/html'/>
495 <format name='marctxt' type='text/plain'/>
496 <format name='ris' type='text/plain'/>
501 my ($type) = keys %$h;
502 $body .= "\t" . unapi_format($h, $type);
504 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
505 $body .= "\t" . unapi_format($h, "$type-full");
506 $body .= "\t" . unapi_format($h, "$type-uris");
510 $body .= "</formats>\n";
514 return Apache2::Const::OK;
518 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
522 ($lib,$depth) = split('/', $4);
524 $type = 'metarecord' if ($scheme =~ /^metabib/o);
525 $type = 'isbn' if ($scheme =~ /^isbn/o);
526 $type = 'acp' if ($scheme =~ /^asset-copy/o);
527 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
528 $type = 'auri' if ($scheme =~ /^asset-uri/o);
529 $type = 'authority' if ($scheme =~ /^authority/o);
530 $command = 'retrieve';
531 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
535 $paging = [split ',', $paging];
540 if (!$lib || $lib eq '-') {
541 $lib = $actor->request(
542 'open-ils.actor.org_unit_list.search' => parent_ou => undef
543 )->gather(1)->[0]->shortname;
546 my ($lib_object,$lib_id,$ou_types,$lib_depth);
547 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
548 $lib_object = $actor->request(
549 'open-ils.actor.org_unit_list.search' => shortname => $lib
551 $lib_id = $lib_object->id;
553 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
554 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
557 if ($command eq 'browse') {
558 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
562 if ($type eq 'isbn') {
563 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
565 # Escape user input before display
566 $command = CGI::escapeHTML($command);
567 $id = CGI::escapeHTML($id);
568 $type = CGI::escapeHTML($type);
569 $format = CGI::escapeHTML(decode_utf8($format));
571 print "Content-type: text/html; charset=utf-8\n\n";
572 $apache->custom_response( 404, <<" HTML");
575 <title>Type [$type] with id [$id] not found!</title>
579 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
590 { (keys(%$_))[0] eq $base_format }
591 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
593 { $_ eq $base_format }
594 qw/opac html htmlholdings marctxt ris holdings_xml/
596 # Escape user input before display
597 $format = CGI::escapeHTML($format);
598 $type = CGI::escapeHTML($type);
600 print "Content-type: text/html; charset=utf-8\n\n";
601 $apache->custom_response( 406, <<" HTML");
604 <title>Invalid format [$format] for type [$type]!</title>
608 <center>Sorry, format $format is not valid for type $type.</center>
615 if ($format eq 'opac') {
616 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
617 if ($type eq 'metarecord');
618 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
619 if ($type eq 'record');
621 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
622 my $feed = create_record_feed(
633 # Escape user input before display
634 $command = CGI::escapeHTML($command);
635 $id = CGI::escapeHTML($id);
636 $type = CGI::escapeHTML($type);
637 $format = CGI::escapeHTML(decode_utf8($format));
639 print "Content-type: text/html; charset=utf-8\n\n";
640 $apache->custom_response( 404, <<" HTML");
643 <title>Type [$type] with id [$id] not found!</title>
647 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
655 $feed->creator($host);
657 $feed->link( unapi => $base) if ($flesh_feed);
659 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
660 print $U->entityize($feed->toString) . "\n";
662 return Apache2::Const::OK;
665 my $method = "open-ils.supercat.$type.$base_format.$command";
667 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
669 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
670 # however, we can have it carry extra options like no_record! (comma separated)
671 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
673 my $req = $supercat->request($method,@params);
674 my $data = $req->gather();
676 if ($req->failed || !$data) {
677 # Escape user input before display
678 $command = CGI::escapeHTML($command);
679 $id = CGI::escapeHTML($id);
680 $type = CGI::escapeHTML($type);
681 $format = CGI::escapeHTML(decode_utf8($format));
683 print "Content-type: text/html; charset=utf-8\n\n";
684 $apache->custom_response( 404, <<" HTML");
687 <title>$type $id not found!</title>
691 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
698 print "Content-type: application/xml; charset=utf-8\n\n";
700 # holdings_xml format comes back to us without an XML declaration
701 # and without being entityized; fix that here
702 if ($base_format eq 'holdings_xml') {
703 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
704 print $U->entityize($data);
706 while (my $c = $req->recv) {
707 print $U->entityize($c->content);
713 return Apache2::Const::OK;
719 return Apache2::Const::DECLINED if (-e $apache->filename);
724 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
725 my $rel_name = $cgi->url(-relative=>1);
726 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
729 my $url = $cgi->url(-path_info=>$add_path);
730 my $root = (split 'supercat', $url)[0];
731 my $base = (split 'supercat', $url)[0] . 'supercat';
732 my $unapi = (split 'supercat', $url)[0] . 'unapi';
734 my $host = $cgi->virtual_host || $cgi->server_name;
736 my $path = $cgi->path_info;
737 my ($id,$type,$format,$command) = reverse split '/', $path;
738 my $flesh_feed = parse_feed_type($format);
739 (my $base_format = $format) =~ s/(-full|-uris)$//o;
741 my $skin = $cgi->param('skin') || 'default';
742 my $locale = $cgi->param('locale') || 'en-US';
744 # Enable localized results of copy status, etc
745 $supercat->session_locale($locale);
747 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
748 print "Content-type: application/xml; charset=utf-8\n";
751 ->request("open-ils.supercat.$1.formats")
759 <type>text/html</type>
762 if ($1 eq 'record' or $1 eq 'isbn') {
764 <name>htmlholdings</name>
765 <type>text/html</type>
769 <type>text/html</type>
772 <name>htmlholdings-full</name>
773 <type>text/html</type>
776 <name>html-full</name>
777 <type>text/html</type>
781 <type>text/plain</type>
785 <type>text/plain</type>
790 my ($type) = keys %$h;
791 print supercat_format($h, $type);
793 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
794 print supercat_format($h, "$type-full");
795 print supercat_format($h, "$type-uris");
800 print "</formats>\n";
802 return Apache2::Const::OK;
806 ->request("open-ils.supercat.record.formats")
811 ->request("open-ils.supercat.metarecord.formats")
815 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
816 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
821 <type>text/html</type>
824 <name>htmlholdings</name>
825 <type>text/html</type>
829 <type>text/html</type>
832 <name>htmlholdings-full</name>
833 <type>text/html</type>
836 <name>html-full</name>
837 <type>text/html</type>
841 <type>text/plain</type>
845 <type>text/plain</type>
849 my ($type) = keys %$h;
850 print supercat_format($h, $type);
852 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
853 print supercat_format($h, "$type-full");
854 print supercat_format($h, "$type-uris");
859 print "</formats>\n";
862 return Apache2::Const::OK;
865 if ($format eq 'opac') {
866 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
867 if ($type eq 'metarecord');
868 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
869 if ($type eq 'record');
872 } elsif ($base_format eq 'marc21') {
876 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
878 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
883 # Escape user input before display
884 $id = CGI::escapeHTML($id);
886 print "Content-type: text/html; charset=utf-8\n\n";
887 $apache->custom_response( 404, <<" HTML");
894 <center>Couldn't fetch $id as MARC21.</center>
901 return Apache2::Const::OK;
903 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
904 my $feed = create_record_feed(
912 $feed->creator($host);
916 $feed->link( unapi => $base) if ($flesh_feed);
918 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
919 print $U->entityize($feed->toString) . "\n";
921 return Apache2::Const::OK;
924 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
928 # Escape user input before display
929 $command = CGI::escapeHTML($command);
930 $id = CGI::escapeHTML($id);
931 $type = CGI::escapeHTML($type);
932 $format = CGI::escapeHTML(decode_utf8($format));
934 print "Content-type: text/html; charset=utf-8\n\n";
935 $apache->custom_response( 404, <<" HTML");
938 <title>$type $id not found!</title>
942 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
949 print "Content-type: application/xml; charset=utf-8\n\n";
950 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
952 return Apache2::Const::OK;
958 return Apache2::Const::DECLINED if (-e $apache->filename);
962 my $year = (gmtime())[5] + 1900;
963 my $host = $cgi->virtual_host || $cgi->server_name;
966 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
967 my $rel_name = $cgi->url(-relative=>1);
968 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
971 my $url = $cgi->url(-path_info=>$add_path);
972 my $root = (split 'feed', $url)[0] . '/';
973 my $base = (split 'bookbag', $url)[0] . '/bookbag';
974 my $unapi = (split 'feed', $url)[0] . '/unapi';
976 my $skin = $cgi->param('skin') || 'default';
977 my $locale = $cgi->param('locale') || 'en-US';
978 my $org = $cgi->param('searchOrg');
980 # Enable localized results of copy status, etc
981 $supercat->session_locale($locale);
983 my $org_unit = get_ou($org);
984 my $scope = "l=" . $org_unit->[0]->id . "&";
986 $root =~ s{(?<!http:)//}{/}go;
987 $base =~ s{(?<!http:)//}{/}go;
988 $unapi =~ s{(?<!http:)//}{/}go;
990 my $path = $cgi->path_info;
991 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
993 my ($id,$type) = reverse split '/', $path;
994 my $flesh_feed = parse_feed_type($type);
996 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
997 return Apache2::Const::NOT_FOUND unless($bucket);
999 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1000 if ($type eq 'opac') {
1001 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1002 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
1007 my $feed = create_record_feed(
1010 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
1012 $org_unit->[0]->shortname,
1017 $feed->id($bucket_tag);
1019 $feed->title("Items in Book Bag [".$bucket->name."]");
1020 $feed->creator($host);
1023 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1024 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1025 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1026 $feed->link(unapi => $unapi);
1030 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1031 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1036 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1037 print $U->entityize($feed->toString) . "\n";
1039 return Apache2::Const::OK;
1044 return Apache2::Const::DECLINED if (-e $apache->filename);
1048 my $year = (gmtime())[5] + 1900;
1049 my $host = $cgi->virtual_host || $cgi->server_name;
1052 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1053 my $rel_name = $cgi->url(-relative=>1);
1054 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1057 my $url = $cgi->url(-path_info=>$add_path);
1058 my $root = (split 'feed', $url)[0];
1059 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1060 my $unapi = (split 'feed', $url)[0] . 'unapi';
1062 my $skin = $cgi->param('skin') || 'default';
1063 my $locale = $cgi->param('locale') || 'en-US';
1064 my $org = $cgi->param('searchOrg');
1066 # Enable localized results of copy status, etc
1067 $supercat->session_locale($locale);
1069 my $org_unit = get_ou($org);
1070 my $scope = "l=" . $org_unit->[0]->id . "&";
1072 my $path = $cgi->path_info;
1073 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1075 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1077 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1078 my $flesh_feed = parse_feed_type($type);
1081 $limit = 10 if $limit !~ /^\d+$/;
1083 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1085 #if ($type eq 'opac') {
1086 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1087 # join('&', map { "rl=" . $_ } @$list) .
1092 my $search = 'record';
1093 if ($rtype eq 'authority') {
1094 $search = 'authority';
1096 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1100 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1102 $feed->title("$limit most recent $rtype ${axis}s");
1105 $feed->creator($host);
1108 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1109 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1110 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1111 $feed->link(unapi => $unapi);
1115 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1116 join('&', map { 'rl=' . $_} @$list ),
1121 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1122 print $U->entityize($feed->toString) . "\n";
1124 return Apache2::Const::OK;
1127 sub opensearch_osd {
1128 my $version = shift;
1133 if ($version eq '1.0') {
1135 Content-type: application/opensearchdescription+xml; charset=utf-8
1137 <?xml version="1.0" encoding="UTF-8"?>
1138 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1139 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1140 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1141 <ShortName>$lib</ShortName>
1142 <LongName>Search $lib</LongName>
1143 <Description>Search the $lib OPAC by $class.</Description>
1144 <Tags>$lib book library</Tags>
1145 <SampleSearch>harry+potter</SampleSearch>
1146 <Developer>Mike Rylander for GPLS/PINES</Developer>
1147 <Contact>feedback\@open-ils.org</Contact>
1148 <SyndicationRight>open</SyndicationRight>
1149 <AdultContent>false</AdultContent>
1150 </OpenSearchDescription>
1154 Content-type: application/opensearchdescription+xml; charset=utf-8
1156 <?xml version="1.0" encoding="UTF-8"?>
1157 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1158 <ShortName>$lib</ShortName>
1159 <Description>Search the $lib OPAC by $class.</Description>
1160 <Tags>$lib book library</Tags>
1161 <Url type="application/rss+xml"
1162 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1163 <Url type="application/atom+xml"
1164 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1165 <Url type="application/x-mods3+xml"
1166 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1167 <Url type="application/x-mods+xml"
1168 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1169 <Url type="application/x-marcxml+xml"
1170 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1171 <Url type="text/html"
1172 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1173 <LongName>Search $lib</LongName>
1174 <Query role="example" searchTerms="harry+potter" />
1175 <Developer>Mike Rylander for GPLS/PINES</Developer>
1176 <Contact>feedback\@open-ils.org</Contact>
1177 <SyndicationRight>open</SyndicationRight>
1178 <AdultContent>false</AdultContent>
1179 <Language>en-US</Language>
1180 <OutputEncoding>UTF-8</OutputEncoding>
1181 <InputEncoding>UTF-8</InputEncoding>
1182 </OpenSearchDescription>
1186 return Apache2::Const::OK;
1189 sub opensearch_feed {
1191 return Apache2::Const::DECLINED if (-e $apache->filename);
1194 my $year = (gmtime())[5] + 1900;
1196 my $host = $cgi->virtual_host || $cgi->server_name;
1199 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1200 my $rel_name = $cgi->url(-relative=>1);
1201 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1204 my $url = $cgi->url(-path_info=>$add_path);
1205 my $root = (split 'opensearch', $url)[0];
1206 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1207 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1209 my $path = $cgi->path_info;
1210 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1212 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1218 if (!$lib || $lib eq '-') {
1219 $lib = $actor->request(
1220 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1221 )->gather(1)->[0]->shortname;
1224 if ($class eq '-') {
1228 return opensearch_osd($version, $lib, $class, $base);
1232 my $page = $cgi->param('startPage') || 1;
1233 my $offset = $cgi->param('startIndex') || 1;
1234 my $limit = $cgi->param('count') || 10;
1236 $page = 1 if ($page !~ /^\d+$/);
1237 $offset = 1 if ($offset !~ /^\d+$/);
1238 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1241 $offset = ($page - 1) * $limit;
1246 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1247 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1249 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1250 $lang = '' if ($lang eq '*');
1252 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1254 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1257 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1258 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1260 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1263 $type = $cgi->param('responseType') if $cgi->param('responseType');
1266 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1270 my $kwt = $cgi->param('kw');
1271 my $tit = $cgi->param('ti');
1272 my $aut = $cgi->param('au');
1273 my $sut = $cgi->param('su');
1274 my $set = $cgi->param('se');
1276 $terms .= " " if ($terms && $kwt);
1277 $terms .= "keyword: $kwt" if ($kwt);
1278 $terms .= " " if ($terms && $tit);
1279 $terms .= "title: $tit" if ($tit);
1280 $terms .= " " if ($terms && $aut);
1281 $terms .= "author: $aut" if ($aut);
1282 $terms .= " " if ($terms && $sut);
1283 $terms .= "subject: $sut" if ($sut);
1284 $terms .= " " if ($terms && $set);
1285 $terms .= "series: $set" if ($set);
1287 if ($version eq '1.0') {
1289 } elsif ($type eq '-') {
1292 my $flesh_feed = parse_feed_type($type);
1294 $terms = decode_utf8($terms);
1295 $lang = 'eng' if ($lang eq 'en-US');
1297 $log->debug("OpenSearch terms: $terms");
1299 my $org_unit = get_ou($org);
1301 # Apostrophes break search and get indexed as spaces anyway
1302 my $safe_terms = $terms;
1303 $safe_terms =~ s{'}{ }go;
1305 my $recs = $search->request(
1306 'open-ils.search.biblio.multiclass.query' => {
1307 org_unit => $org_unit->[0]->id,
1311 sort_dir => $sortdir,
1312 default_class => $class,
1313 ($lang ? ( 'language' => $lang ) : ()),
1314 } => $safe_terms => 1
1317 $log->debug("Hits for [$terms]: $recs->{count}");
1319 my $feed = create_record_feed(
1322 [ map { $_->[0] } @{$recs->{ids}} ],
1329 $log->debug("Feed created...");
1333 $feed->search($safe_terms);
1334 $feed->class($class);
1336 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1338 $feed->creator($host);
1341 $feed->_create_node(
1342 $feed->{item_xpath},
1343 'http://a9.com/-/spec/opensearch/1.1/',
1348 $feed->_create_node(
1349 $feed->{item_xpath},
1350 'http://a9.com/-/spec/opensearch/1.1/',
1355 $feed->_create_node(
1356 $feed->{item_xpath},
1357 'http://a9.com/-/spec/opensearch/1.1/',
1362 $log->debug("...basic feed data added...");
1366 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1367 'application/opensearch+xml'
1368 ) if ($offset + $limit < $recs->{count});
1372 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1373 'application/opensearch+xml'
1378 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1379 'application/opensearch+xml'
1384 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1385 'application/rss+xml'
1390 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1391 'application/atom+xml'
1396 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1402 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1406 $feed->link( 'unapi-server' => $unapi);
1408 $log->debug("...feed links added...");
1412 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1413 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1417 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1418 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1420 $log->debug("...and feed returned.");
1422 return Apache2::Const::OK;
1425 sub create_record_feed {
1428 my $records = shift;
1431 my $lib = uc(shift()) || '-';
1438 my $base = $cgi->url;
1439 my $host = $cgi->virtual_host || $cgi->server_name;
1441 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1445 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1447 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1449 $type =~ s/(-full|-uris)$//o;
1451 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1452 $feed->base($base) if ($flesh);
1453 $feed->unapi($unapi) if ($flesh);
1455 $type = 'atom' if ($type eq 'html');
1456 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1458 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1461 for my $record (@$records) {
1462 next unless($record);
1464 #my $rec = $record->id;
1467 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1468 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1469 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1470 $item_tag .= "/$depth" if (defined($depth));
1472 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1474 my $xml = $supercat->request(
1475 "open-ils.supercat.$search.$type.retrieve",
1480 my $node = $feed->add_item($xml);
1484 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1485 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1486 while ( !$r->complete ) {
1487 $xml .= join('', map {$_->content} $r->recv);
1489 $xml .= join('', map {$_->content} $r->recv);
1490 $node->add_holdings($xml);
1493 $node->id($item_tag);
1494 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1495 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1496 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1497 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1498 $node->link('unapi-id' => $item_tag) if ($flesh);
1506 return Apache2::Const::DECLINED if (-e $apache->filename);
1509 my $year = (gmtime())[5] + 1900;
1511 my $host = $cgi->virtual_host || $cgi->server_name;
1514 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1515 my $rel_name = $cgi->url(-relative=>1);
1516 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1519 my $url = $cgi->url(-path_info=>$add_path);
1520 my $root = (split 'browse', $url)[0];
1521 my $base = (split 'browse', $url)[0] . 'browse';
1522 my $unapi = (split 'browse', $url)[0] . 'unapi';
1524 my $path = $cgi->path_info;
1527 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1528 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1530 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1532 my $status = [$cgi->param('status')];
1533 my $cpLoc = [$cgi->param('copyLocation')];
1534 $site ||= $cgi->param('searchOrg');
1535 $page ||= $cgi->param('startPage') || 0;
1536 $page_size ||= $cgi->param('count') || 9;
1538 $page = 0 if ($page !~ /^-?\d+$/);
1539 $page_size = 9 if $page_size !~ /^\d+$/;
1541 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1542 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1544 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1545 warn "something's wrong...";
1546 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1550 $string = decode_utf8($string);
1551 $string =~ s/\+/ /go;
1554 my $tree = $supercat->request(
1555 "open-ils.supercat.$axis.browse",
1557 (($axis =~ /^authority/) ? () : ($site)),
1564 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1566 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1567 print $header.$content;
1568 return Apache2::Const::OK;
1571 sub string_startwith {
1573 return Apache2::Const::DECLINED if (-e $apache->filename);
1576 my $year = (gmtime())[5] + 1900;
1578 my $host = $cgi->virtual_host || $cgi->server_name;
1581 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1582 my $rel_name = $cgi->url(-relative=>1);
1583 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1586 my $url = $cgi->url(-path_info=>$add_path);
1587 my $root = (split 'startwith', $url)[0];
1588 my $base = (split 'startwith', $url)[0] . 'startwith';
1589 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1591 my $path = $cgi->path_info;
1594 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1595 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1597 my $status = [$cgi->param('status')];
1598 my $cpLoc = [$cgi->param('copyLocation')];
1599 $site ||= $cgi->param('searchOrg');
1600 $page ||= $cgi->param('startPage') || 0;
1601 $page_size ||= $cgi->param('count') || 9;
1603 $page = 0 if ($page !~ /^-?\d+$/);
1604 $page_size = 9 if $page_size !~ /^\d+$/;
1606 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1607 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1609 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1610 warn "something's wrong...";
1611 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1615 $string = decode_utf8($string);
1616 $string =~ s/\+/ /go;
1619 my $tree = $supercat->request(
1620 "open-ils.supercat.$axis.startwith",
1622 (($axis =~ /^authority/) ? () : ($site)),
1629 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1631 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1632 print $header.$content;
1633 return Apache2::Const::OK;
1636 sub item_age_browse {
1638 return Apache2::Const::DECLINED if (-e $apache->filename);
1641 my $year = (gmtime())[5] + 1900;
1643 my $host = $cgi->virtual_host || $cgi->server_name;
1646 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1647 my $rel_name = $cgi->url(-relative=>1);
1648 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1651 my $url = $cgi->url(-path_info=>$add_path);
1652 my $root = (split 'browse', $url)[0];
1653 my $base = (split 'browse', $url)[0] . 'browse';
1654 my $unapi = (split 'browse', $url)[0] . 'unapi';
1656 my $path = $cgi->path_info;
1659 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1660 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1662 unless ($axis eq 'item-age') {
1663 warn "something's wrong...";
1664 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1668 my $status = [$cgi->param('status')];
1669 my $cpLoc = [$cgi->param('copyLocation')];
1670 $site ||= $cgi->param('searchOrg') || '-';
1671 $page ||= $cgi->param('startPage') || 1;
1672 $page_size ||= $cgi->param('count') || 10;
1674 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1675 $page_size = 10 if $page_size !~ /^\d+$/;
1677 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1678 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1680 my $recs = $supercat->request(
1681 "open-ils.supercat.new_book_list",
1689 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1691 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1692 print $header.$content;
1693 return Apache2::Const::OK;
1696 our %qualifier_ids = (
1697 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1698 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1699 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1703 # Our authority search options are currently pretty impoverished;
1704 # just right-truncated string match on a few categories, or by
1706 our %nested_auth_qualifier_map = (
1708 id => { index => 'id', title => 'Record number'},
1709 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1710 title => { index => 'title', title => 'Uniform title'},
1711 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1712 topic => { index => 'topic', title => 'Topical term'},
1716 my $base_explain = <<XML;
1718 id="evergreen-sru-explain-full"
1719 authoritative="true"
1720 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1721 xmlns="http://explain.z3950.org/dtd/2.0/">
1722 <serverInfo transport="http" protocol="SRU" version="1.1">
1729 <title primary="true"/>
1730 <description primary="true"/>
1734 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1739 identifier="info:srw/schema/1/marcxml-v1.1"
1740 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1744 <title>MARC21Slim (marcxml)</title>
1749 <default type="numberOfRecords">10</default>
1750 <default type="contextSet">eg</default>
1751 <default type="index">keyword</default>
1752 <default type="relation">all</default>
1753 <default type="sortSchema">marcxml</default>
1754 <default type="retrieveSchema">marcxml</default>
1755 <setting type="maximumRecords">50</setting>
1756 <supports type="relationModifier">relevant</supports>
1757 <supports type="relationModifier">stem</supports>
1758 <supports type="relationModifier">fuzzy</supports>
1759 <supports type="relationModifier">word</supports>
1770 my $req = SRU::Request->newFromCGI( $cgi );
1771 my $resp = SRU::Response->newFromRequest( $req );
1773 # Find the org_unit shortname, if passed as part of the URL
1774 # http://example.com/opac/extras/sru/SHORTNAME
1775 my $url = $cgi->path_info;
1776 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1778 if ( $resp->type eq 'searchRetrieve' ) {
1780 # Older versions of Debian packages returned terms to us double-encoded,
1781 # so we had to forcefully double-decode them a second time with
1782 # an outer decode('utf8', $string) call; this seems to be resolved with
1783 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1784 my $cql_query = decode_utf8($req->query);
1785 my $search_string = decode_utf8($req->cql->toEvergreen);
1787 # Ensure the search string overrides the default site
1788 if ($shortname and $search_string !~ m#site:#) {
1789 $search_string .= " site:$shortname";
1792 my $offset = $req->startRecord;
1793 $offset-- if ($offset);
1796 my $limit = $req->maximumRecords;
1799 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1801 my $recs = $search->request(
1802 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1805 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1807 foreach my $record (@$bre) {
1808 my $marcxml = $record->marc;
1809 # Make the beast conform to a VDX-supported format
1810 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1811 # Trying to implement LIBSOL_852_A format; so much for standards
1813 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1814 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1816 # Force record leader to 'a' as our data is always UTF8
1817 # Avoids marc8_to_utf8 from being invoked with horrible results
1818 # on the off-chance the record leader isn't correct
1819 my $ldr = $marc->leader;
1820 substr($ldr, 9, 1, 'a');
1821 $marc->leader($ldr);
1823 # Expects the record ID in the 001
1824 $marc->delete_field($_) for ($marc->field('001'));
1825 if (!$marc->field('001')) {
1826 $marc->insert_fields_ordered(
1827 MARC::Field->new( '001', $record->id )
1830 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1831 foreach my $cn (keys %$bib_holdings) {
1832 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1833 $marc->insert_fields_ordered(
1836 a => $cp->{'location'},
1837 b => $bib_holdings->{$cn}->{'owning_lib'},
1839 d => $cp->{'circlib'},
1840 g => $cp->{'barcode'},
1841 n => $cp->{'status'},
1847 # Ensure the data is encoded as UTF8 before we hand it off
1848 $marcxml = encode_utf8($marc->as_xml_record());
1849 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1853 SRU::Response::Record->new(
1854 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1855 recordData => $marcxml,
1856 recordPosition => ++$offset
1861 $resp->numberOfRecords($recs->{count});
1863 } elsif ( $resp->type eq 'explain' ) {
1864 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1866 \%OpenILS::WWW::SuperCat::qualifier_ids
1870 SRU::Response::Record->new(
1871 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1872 recordData => $ex_doc
1877 print $cgi->header( -type => 'application/xml' );
1878 print $U->entityize($resp->asXML) . "\n";
1879 return Apache2::Const::OK;
1884 package CQL::BooleanNode;
1888 my $left = $self->left();
1889 my $right = $self->right();
1890 my $leftStr = $left->toEvergreen;
1891 my $rightStr = $right->toEvergreen();
1893 my $op = '||' if uc $self->op() eq 'OR';
1896 return "$leftStr $rightStr";
1899 sub toEvergreenAuth {
1900 return toEvergreen(shift);
1903 package CQL::TermNode;
1907 my $qualifier = $self->getQualifier();
1908 my $term = $self->getTerm();
1909 my $relation = $self->getRelation();
1913 my ($qset, $qname) = split(/\./, $qualifier);
1915 if ( exists($qualifier_map{$qset}{$qname}) ) {
1916 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1917 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1920 my @modifiers = $relation->getModifiers();
1922 my $base = $relation->getBase();
1923 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1926 foreach my $m ( @modifiers ) {
1927 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1933 $quote_it = 0 if ( $base eq 'all' );
1934 $term = maybeQuote($term) if $quote_it;
1937 croak( "Evergreen doesn't support the $base relations" );
1945 return "$qualifier:$term";
1948 sub toEvergreenAuth {
1950 my $qualifier = $self->getQualifier();
1951 my $term = $self->getTerm();
1952 my $relation = $self->getRelation();
1956 my ($qset, $qname) = split(/\./, $qualifier);
1958 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1959 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1960 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1963 return { qualifier => $qualifier, term => $term };
1968 sub sru_auth_search {
1971 my $req = SRU::Request->newFromCGI( $cgi );
1972 my $resp = SRU::Response->newFromRequest( $req );
1974 if ( $resp->type eq 'searchRetrieve' ) {
1975 return_auth_response($cgi, $req, $resp);
1976 } elsif ( $resp->type eq 'explain' ) {
1977 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1978 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1979 \%OpenILS::WWW::SuperCat::qualifier_ids
1983 print $cgi->header( -type => 'application/xml' );
1984 print $U->entityize($resp->asXML) . "\n";
1985 return Apache2::Const::OK;
1988 sub explain_header {
1991 my $host = $cgi->virtual_host || $cgi->server_name;
1994 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1995 my $rel_name = $cgi->url(-relative=>1);
1996 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1998 my $base = $cgi->url(-base=>1);
1999 my $url = $cgi->url(-path_info=>$add_path);
2000 $url =~ s/^$base\///o;
2002 my $doc = $parser->parse_string($base_explain);
2003 my $e = $doc->documentElement;
2004 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2005 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2006 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2011 sub return_sru_explain {
2012 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2014 $index_map ||= \%qualifier_map;
2016 my ($doc, $e) = explain_header($cgi);
2017 for my $name ( keys %{$index_map} ) {
2019 my $identifier = $qualifier_ids->{ $name };
2021 next unless $identifier;
2023 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2024 $set_node->setAttribute( identifier => $identifier );
2025 $set_node->setAttribute( name => $name );
2027 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2028 for my $index ( sort keys %{$index_map->{$name}} ) {
2029 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2031 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2032 $map_node->appendChild( $name_node );
2034 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2036 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2037 $index_node->appendChild( $title_node );
2038 $index_node->appendChild( $map_node );
2040 $index_node->setAttribute( id => "$name.$index" );
2041 $title_node->appendText($index_map->{$name}{$index}{'title'});
2042 $name_node->setAttribute( set => $name );
2043 $name_node->appendText($index_map->{$name}{$index}{'index'});
2045 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2049 $$explain = $e->toString;
2053 SRU::Response::Record->new(
2054 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2055 recordData => $$explain
2061 sub return_auth_response {
2062 my ($cgi, $req, $resp) = @_;
2064 my $cql_query = decode_utf8($req->query);
2065 my $search = $req->cql->toEvergreenAuth;
2067 my $qualifier = decode_utf8($search->{qualifier});
2068 my $term = decode_utf8($search->{term});
2070 $log->info("SRU NAF search string [$cql_query] converted to "
2071 . "[$qualifier:$term]\n");
2073 my $page_size = $req->maximumRecords;
2076 # startwith deals with pages, so convert startRecord to a page number
2077 my $page = ($req->startRecord / $page_size) || 0;
2080 if ($qualifier eq "id") {
2081 $recs = [ int($term) ];
2083 $recs = $supercat->request(
2084 "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2088 my $record_position = $req->startRecord;
2089 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2090 foreach my $record (@$recs) {
2091 my $marcxml = $cstore->request(
2092 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2096 SRU::Response::Record->new(
2097 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2098 recordData => $marcxml,
2099 recordPosition => ++$record_position
2104 $resp->numberOfRecords(scalar(@$recs));
2107 =head2 get_ou($org_unit)
2109 Returns an aou object for a given actor.org_unit shortname or ID.
2114 my $org = shift || '-';
2118 $org_unit = $actor->request(
2119 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2121 } elsif ($org !~ /^\d+$/o) {
2122 $org_unit = $actor->request(
2123 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2126 $org_unit = $actor->request(
2127 'open-ils.actor.org_unit_list.search' => id => $org