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 my $auth_axes = $supercat
238 ->request("open-ils.supercat.authority.browse_axis_list")
242 for my $axis ( @$auth_axes ) {
243 my $basic_axis = 'authority.' . $axis;
244 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
247 my $__a = $browse_axis;
249 $browse_types{$__a}{$__f} = sub {
250 my $record_list = shift;
253 my $real_format = shift || $__f;
258 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
259 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
260 $feed->root( "$base/../" );
261 $feed->link( next => $next => $feed->type );
262 $feed->link( previous => $prev => $feed->type );
265 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
274 =head2 parse_feed_type($type)
276 Determines whether and how a given feed type needs to be "fleshed out"
277 with holdings information.
279 The feed type could end with the string "-full", in which case we want
280 to return call numbers, copies, and URIS.
282 Or the feed type could end with "-uris", in which case we want to return
283 call numbers and URIS.
285 Otherwise, we won't return any holdings.
289 sub parse_feed_type {
290 my $type = shift || '';
292 if ($type =~ /-full$/o) {
296 if ($type =~ /-uris$/o) {
300 # Otherwise, we'll return just the facts, ma'am
304 =head2 supercat_format($format_hashref, $format_type)
306 Given a reference to a hash containing the namespace_uri,
307 docs, and schema location attributes for a set of formats,
308 generate the XML description required by the supercat service.
310 We derive the base type from the format type so that we do not
311 have to populate the hash with redundant information.
315 sub supercat_format {
319 (my $base_type = $type) =~ s/(-full|-uris)$//o;
321 my $format = "<format><name>$type</name><type>application/xml</type>";
323 for my $part ( qw/namespace_uri docs schema_location/ ) {
324 $format .= "<$part>$$h{$base_type}{$part}</$part>"
325 if ($$h{$base_type}{$part});
328 $format .= '</format>';
333 =head2 unapi_format($format_hashref, $format_type)
335 Given a reference to a hash containing the namespace_uri,
336 docs, and schema location attributes for a set of formats,
337 generate the XML description required by the supercat service.
339 We derive the base type from the format type so that we do not
340 have to populate the hash with redundant information.
348 (my $base_type = $type) =~ s/(-full|-uris)$//o;
350 my $format = "<format name='$type' type='application/xml'";
352 for my $part ( qw/namespace_uri docs schema_location/ ) {
353 $format .= " $part='$$h{$base_type}{$part}'"
354 if ($$h{$base_type}{$part});
366 return Apache2::Const::DECLINED if (-e $apache->filename);
368 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
371 ->request("open-ils.supercat.oisbn", $isbn)
374 print "Content-type: application/xml; charset=utf-8\n\n";
375 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
377 unless (exists $$list{metarecord}) {
379 return Apache2::Const::OK;
382 print "<idlist metarecord='$$list{metarecord}'>\n";
384 for ( keys %{ $$list{record_list} } ) {
385 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
386 print " <isbn record='$_'>$o</isbn>\n"
391 return Apache2::Const::OK;
397 return Apache2::Const::DECLINED if (-e $apache->filename);
402 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
403 my $rel_name = $cgi->url(-relative=>1);
404 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
407 my $url = $cgi->url(-path_info=>$add_path);
408 my $root = (split 'unapi', $url)[0];
409 my $base = (split 'unapi', $url)[0] . 'unapi';
412 my $uri = $cgi->param('id') || '';
413 my $host = $cgi->virtual_host || $cgi->server_name;
415 my $skin = $cgi->param('skin') || 'default';
416 my $locale = $cgi->param('locale') || 'en-US';
418 # Enable localized results of copy status, etc
419 $supercat->session_locale($locale);
421 my $format = $cgi->param('format') || '';
422 my $flesh_feed = parse_feed_type($format);
423 (my $base_format = $format) =~ s/(-full|-uris)$//o;
424 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
425 my $body = "Content-type: application/xml; charset=utf-8\n\n";
427 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
430 ($lib,$depth) = split('/', $4);
431 $type = 'metarecord' if ($1 =~ /^m/o);
432 $type = 'authority' if ($1 =~ /^authority/o);
436 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
439 ->request("open-ils.supercat.$type.formats")
442 if ($type eq 'record' or $type eq 'isbn') {
443 $body .= <<" FORMATS";
445 <format name='opac' type='text/html'/>
446 <format name='html' type='text/html'/>
447 <format name='htmlholdings' type='text/html'/>
448 <format name='holdings_xml' type='application/xml'/>
449 <format name='holdings_xml-full' type='application/xml'/>
450 <format name='html-full' type='text/html'/>
451 <format name='htmlholdings-full' type='text/html'/>
452 <format name='marctxt' type='text/plain'/>
453 <format name='ris' type='text/plain'/>
455 } elsif ($type eq 'metarecord') {
456 $body .= <<" FORMATS";
458 <format name='opac' type='text/html'/>
461 $body .= <<" FORMATS";
467 my ($type) = keys %$h;
468 $body .= unapi_format($h, $type);
470 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
471 $body .= unapi_format($h, "$type-full");
472 $body .= unapi_format($h, "$type-uris");
476 $body .= "</formats>\n";
480 ->request("open-ils.supercat.$type.formats")
485 ->request("open-ils.supercat.metarecord.formats")
489 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
490 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
492 $body .= <<" FORMATS";
494 <format name='opac' type='text/html'/>
495 <format name='html' type='text/html'/>
496 <format name='htmlholdings' type='text/html'/>
497 <format name='holdings_xml' type='application/xml'/>
498 <format name='holdings_xml-full' type='application/xml'/>
499 <format name='html-full' type='text/html'/>
500 <format name='htmlholdings-full' type='text/html'/>
501 <format name='marctxt' type='text/plain'/>
502 <format name='ris' type='text/plain'/>
507 my ($type) = keys %$h;
508 $body .= "\t" . unapi_format($h, $type);
510 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
511 $body .= "\t" . unapi_format($h, "$type-full");
512 $body .= "\t" . unapi_format($h, "$type-uris");
516 $body .= "</formats>\n";
520 return Apache2::Const::OK;
524 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
528 ($lib,$depth) = split('/', $4);
530 $type = 'metarecord' if ($scheme =~ /^metabib/o);
531 $type = 'isbn' if ($scheme =~ /^isbn/o);
532 $type = 'acp' if ($scheme =~ /^asset-copy/o);
533 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
534 $type = 'auri' if ($scheme =~ /^asset-uri/o);
535 $type = 'authority' if ($scheme =~ /^authority/o);
536 $command = 'retrieve';
537 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
538 $command = 'browse' if ($scheme =~ /^authority/);
542 $paging = [split ',', $paging];
547 if (!$lib || $lib eq '-') {
548 $lib = $actor->request(
549 'open-ils.actor.org_unit_list.search' => parent_ou => undef
550 )->gather(1)->[0]->shortname;
553 my ($lib_object,$lib_id,$ou_types,$lib_depth);
554 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
555 $lib_object = $actor->request(
556 'open-ils.actor.org_unit_list.search' => shortname => $lib
558 $lib_id = $lib_object->id;
560 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
561 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
564 if ($command eq 'browse') {
565 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
569 if ($type eq 'isbn') {
570 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
572 # Escape user input before display
573 $command = CGI::escapeHTML($command);
574 $id = CGI::escapeHTML($id);
575 $type = CGI::escapeHTML($type);
576 $format = CGI::escapeHTML(decode_utf8($format));
578 print "Content-type: text/html; charset=utf-8\n\n";
579 $apache->custom_response( 404, <<" HTML");
582 <title>Type [$type] with id [$id] not found!</title>
586 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
597 { (keys(%$_))[0] eq $base_format }
598 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
600 { $_ eq $base_format }
601 qw/opac html htmlholdings marctxt ris holdings_xml/
603 # Escape user input before display
604 $format = CGI::escapeHTML($format);
605 $type = CGI::escapeHTML($type);
607 print "Content-type: text/html; charset=utf-8\n\n";
608 $apache->custom_response( 406, <<" HTML");
611 <title>Invalid format [$format] for type [$type]!</title>
615 <center>Sorry, format $format is not valid for type $type.</center>
622 if ($format eq 'opac') {
623 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
624 if ($type eq 'metarecord');
625 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
626 if ($type eq 'record');
628 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
629 my $feed = create_record_feed(
640 # Escape user input before display
641 $command = CGI::escapeHTML($command);
642 $id = CGI::escapeHTML($id);
643 $type = CGI::escapeHTML($type);
644 $format = CGI::escapeHTML(decode_utf8($format));
646 print "Content-type: text/html; charset=utf-8\n\n";
647 $apache->custom_response( 404, <<" HTML");
650 <title>Type [$type] with id [$id] not found!</title>
654 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
662 $feed->creator($host);
664 $feed->link( unapi => $base) if ($flesh_feed);
666 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
667 print $U->entityize($feed->toString) . "\n";
669 return Apache2::Const::OK;
672 my $method = "open-ils.supercat.$type.$base_format.$command";
674 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
676 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
677 # however, we can have it carry extra options like no_record! (comma separated)
678 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
680 my $req = $supercat->request($method,@params);
681 my $data = $req->gather();
683 if ($req->failed || !$data) {
684 # Escape user input before display
685 $command = CGI::escapeHTML($command);
686 $id = CGI::escapeHTML($id);
687 $type = CGI::escapeHTML($type);
688 $format = CGI::escapeHTML(decode_utf8($format));
690 print "Content-type: text/html; charset=utf-8\n\n";
691 $apache->custom_response( 404, <<" HTML");
694 <title>$type $id not found!</title>
698 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
705 print "Content-type: application/xml; charset=utf-8\n\n";
707 # holdings_xml format comes back to us without an XML declaration
708 # and without being entityized; fix that here
709 if ($base_format eq 'holdings_xml') {
710 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
711 print $U->entityize($data);
713 while (my $c = $req->recv) {
714 print $U->entityize($c->content);
720 return Apache2::Const::OK;
726 return Apache2::Const::DECLINED if (-e $apache->filename);
731 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
732 my $rel_name = $cgi->url(-relative=>1);
733 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
736 my $url = $cgi->url(-path_info=>$add_path);
737 my $root = (split 'supercat', $url)[0];
738 my $base = (split 'supercat', $url)[0] . 'supercat';
739 my $unapi = (split 'supercat', $url)[0] . 'unapi';
741 my $host = $cgi->virtual_host || $cgi->server_name;
743 my $path = $cgi->path_info;
744 my ($id,$type,$format,$command) = reverse split '/', $path;
745 my $flesh_feed = parse_feed_type($format);
746 (my $base_format = $format) =~ s/(-full|-uris)$//o;
748 my $skin = $cgi->param('skin') || 'default';
749 my $locale = $cgi->param('locale') || 'en-US';
751 # Enable localized results of copy status, etc
752 $supercat->session_locale($locale);
754 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
755 print "Content-type: application/xml; charset=utf-8\n";
758 ->request("open-ils.supercat.$1.formats")
766 <type>text/html</type>
769 if ($1 eq 'record' or $1 eq 'isbn') {
771 <name>htmlholdings</name>
772 <type>text/html</type>
776 <type>text/html</type>
779 <name>htmlholdings-full</name>
780 <type>text/html</type>
783 <name>html-full</name>
784 <type>text/html</type>
788 <type>text/plain</type>
792 <type>text/plain</type>
797 my ($type) = keys %$h;
798 print supercat_format($h, $type);
800 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
801 print supercat_format($h, "$type-full");
802 print supercat_format($h, "$type-uris");
807 print "</formats>\n";
809 return Apache2::Const::OK;
813 ->request("open-ils.supercat.record.formats")
818 ->request("open-ils.supercat.metarecord.formats")
822 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
823 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
828 <type>text/html</type>
831 <name>htmlholdings</name>
832 <type>text/html</type>
836 <type>text/html</type>
839 <name>htmlholdings-full</name>
840 <type>text/html</type>
843 <name>html-full</name>
844 <type>text/html</type>
848 <type>text/plain</type>
852 <type>text/plain</type>
856 my ($type) = keys %$h;
857 print supercat_format($h, $type);
859 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
860 print supercat_format($h, "$type-full");
861 print supercat_format($h, "$type-uris");
866 print "</formats>\n";
869 return Apache2::Const::OK;
872 if ($format eq 'opac') {
873 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
874 if ($type eq 'metarecord');
875 print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
876 if ($type eq 'record');
879 } elsif ($base_format eq 'marc21') {
883 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
885 print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
890 # Escape user input before display
891 $id = CGI::escapeHTML($id);
893 print "Content-type: text/html; charset=utf-8\n\n";
894 $apache->custom_response( 404, <<" HTML");
901 <center>Couldn't fetch $id as MARC21.</center>
908 return Apache2::Const::OK;
910 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
911 my $feed = create_record_feed(
919 $feed->creator($host);
923 $feed->link( unapi => $base) if ($flesh_feed);
925 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
926 print $U->entityize($feed->toString) . "\n";
928 return Apache2::Const::OK;
931 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
935 # Escape user input before display
936 $command = CGI::escapeHTML($command);
937 $id = CGI::escapeHTML($id);
938 $type = CGI::escapeHTML($type);
939 $format = CGI::escapeHTML(decode_utf8($format));
941 print "Content-type: text/html; charset=utf-8\n\n";
942 $apache->custom_response( 404, <<" HTML");
945 <title>$type $id not found!</title>
949 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
956 print "Content-type: application/xml; charset=utf-8\n\n";
957 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
959 return Apache2::Const::OK;
965 return Apache2::Const::DECLINED if (-e $apache->filename);
969 my $year = (gmtime())[5] + 1900;
970 my $host = $cgi->virtual_host || $cgi->server_name;
973 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
974 my $rel_name = $cgi->url(-relative=>1);
975 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
978 my $url = $cgi->url(-path_info=>$add_path);
979 my $root = (split 'feed', $url)[0] . '/';
980 my $base = (split 'bookbag', $url)[0] . '/bookbag';
981 my $unapi = (split 'feed', $url)[0] . '/unapi';
983 my $skin = $cgi->param('skin') || 'default';
984 my $locale = $cgi->param('locale') || 'en-US';
985 my $org = $cgi->param('searchOrg');
987 # Enable localized results of copy status, etc
988 $supercat->session_locale($locale);
990 my $org_unit = get_ou($org);
991 my $scope = "l=" . $org_unit->[0]->id . "&";
993 $root =~ s{(?<!http:)//}{/}go;
994 $base =~ s{(?<!http:)//}{/}go;
995 $unapi =~ s{(?<!http:)//}{/}go;
997 my $path = $cgi->path_info;
998 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1000 my ($id,$type) = reverse split '/', $path;
1001 my $flesh_feed = parse_feed_type($type);
1003 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1004 return Apache2::Const::NOT_FOUND unless($bucket);
1006 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1007 if ($type eq 'opac') {
1008 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1009 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
1014 my $feed = create_record_feed(
1017 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
1019 $org_unit->[0]->shortname,
1024 $feed->id($bucket_tag);
1026 $feed->title("Items in Book Bag [".$bucket->name."]");
1027 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1028 $feed->creator($host);
1031 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1032 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1033 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1034 $feed->link(unapi => $unapi);
1038 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1039 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1044 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1045 print $U->entityize($feed->toString) . "\n";
1047 return Apache2::Const::OK;
1052 return Apache2::Const::DECLINED if (-e $apache->filename);
1056 my $year = (gmtime())[5] + 1900;
1057 my $host = $cgi->virtual_host || $cgi->server_name;
1060 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1061 my $rel_name = $cgi->url(-relative=>1);
1062 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1065 my $url = $cgi->url(-path_info=>$add_path);
1066 my $root = (split 'feed', $url)[0];
1067 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1068 my $unapi = (split 'feed', $url)[0] . 'unapi';
1070 my $skin = $cgi->param('skin') || 'default';
1071 my $locale = $cgi->param('locale') || 'en-US';
1072 my $org = $cgi->param('searchOrg');
1074 # Enable localized results of copy status, etc
1075 $supercat->session_locale($locale);
1077 my $org_unit = get_ou($org);
1078 my $scope = "l=" . $org_unit->[0]->id . "&";
1080 my $path = $cgi->path_info;
1081 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1083 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1085 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1086 my $flesh_feed = parse_feed_type($type);
1089 $limit = 10 if $limit !~ /^\d+$/;
1091 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1093 #if ($type eq 'opac') {
1094 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1095 # join('&', map { "rl=" . $_ } @$list) .
1100 my $search = 'record';
1101 if ($rtype eq 'authority') {
1102 $search = 'authority';
1104 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1108 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1110 $feed->title("$limit most recent $rtype ${axis}s");
1113 $feed->creator($host);
1116 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1117 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1118 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1119 $feed->link(unapi => $unapi);
1123 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1124 join('&', map { 'rl=' . $_} @$list ),
1129 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1130 print $U->entityize($feed->toString) . "\n";
1132 return Apache2::Const::OK;
1135 sub opensearch_osd {
1136 my $version = shift;
1141 if ($version eq '1.0') {
1143 Content-type: application/opensearchdescription+xml; charset=utf-8
1145 <?xml version="1.0" encoding="UTF-8"?>
1146 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1147 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1148 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1149 <ShortName>$lib</ShortName>
1150 <LongName>Search $lib</LongName>
1151 <Description>Search the $lib OPAC by $class.</Description>
1152 <Tags>$lib book library</Tags>
1153 <SampleSearch>harry+potter</SampleSearch>
1154 <Developer>Mike Rylander for GPLS/PINES</Developer>
1155 <Contact>feedback\@open-ils.org</Contact>
1156 <SyndicationRight>open</SyndicationRight>
1157 <AdultContent>false</AdultContent>
1158 </OpenSearchDescription>
1162 Content-type: application/opensearchdescription+xml; charset=utf-8
1164 <?xml version="1.0" encoding="UTF-8"?>
1165 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1166 <ShortName>$lib</ShortName>
1167 <Description>Search the $lib OPAC by $class.</Description>
1168 <Tags>$lib book library</Tags>
1169 <Url type="application/rss+xml"
1170 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1171 <Url type="application/atom+xml"
1172 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1173 <Url type="application/x-mods3+xml"
1174 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1175 <Url type="application/x-mods+xml"
1176 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1177 <Url type="application/x-marcxml+xml"
1178 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1179 <Url type="text/html"
1180 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1181 <LongName>Search $lib</LongName>
1182 <Query role="example" searchTerms="harry+potter" />
1183 <Developer>Mike Rylander for GPLS/PINES</Developer>
1184 <Contact>feedback\@open-ils.org</Contact>
1185 <SyndicationRight>open</SyndicationRight>
1186 <AdultContent>false</AdultContent>
1187 <Language>en-US</Language>
1188 <OutputEncoding>UTF-8</OutputEncoding>
1189 <InputEncoding>UTF-8</InputEncoding>
1190 </OpenSearchDescription>
1194 return Apache2::Const::OK;
1197 sub opensearch_feed {
1199 return Apache2::Const::DECLINED if (-e $apache->filename);
1202 my $year = (gmtime())[5] + 1900;
1204 my $host = $cgi->virtual_host || $cgi->server_name;
1207 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1208 my $rel_name = $cgi->url(-relative=>1);
1209 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1212 my $url = $cgi->url(-path_info=>$add_path);
1213 my $root = (split 'opensearch', $url)[0];
1214 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1215 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1217 my $path = $cgi->path_info;
1218 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1220 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1226 if (!$lib || $lib eq '-') {
1227 $lib = $actor->request(
1228 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1229 )->gather(1)->[0]->shortname;
1232 if ($class eq '-') {
1236 return opensearch_osd($version, $lib, $class, $base);
1240 my $page = $cgi->param('startPage') || 1;
1241 my $offset = $cgi->param('startIndex') || 1;
1242 my $limit = $cgi->param('count') || 10;
1244 $page = 1 if ($page !~ /^\d+$/);
1245 $offset = 1 if ($offset !~ /^\d+$/);
1246 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1249 $offset = ($page - 1) * $limit;
1254 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1255 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1257 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1258 $lang = '' if ($lang eq '*');
1260 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1262 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1265 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1266 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1268 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1271 $type = $cgi->param('responseType') if $cgi->param('responseType');
1274 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1278 my $kwt = $cgi->param('kw');
1279 my $tit = $cgi->param('ti');
1280 my $aut = $cgi->param('au');
1281 my $sut = $cgi->param('su');
1282 my $set = $cgi->param('se');
1284 $terms .= " " if ($terms && $kwt);
1285 $terms .= "keyword: $kwt" if ($kwt);
1286 $terms .= " " if ($terms && $tit);
1287 $terms .= "title: $tit" if ($tit);
1288 $terms .= " " if ($terms && $aut);
1289 $terms .= "author: $aut" if ($aut);
1290 $terms .= " " if ($terms && $sut);
1291 $terms .= "subject: $sut" if ($sut);
1292 $terms .= " " if ($terms && $set);
1293 $terms .= "series: $set" if ($set);
1295 if ($version eq '1.0') {
1297 } elsif ($type eq '-') {
1300 my $flesh_feed = parse_feed_type($type);
1302 $terms = decode_utf8($terms);
1303 $lang = 'eng' if ($lang eq 'en-US');
1305 $log->debug("OpenSearch terms: $terms");
1307 my $org_unit = get_ou($org);
1309 # Apostrophes break search and get indexed as spaces anyway
1310 my $safe_terms = $terms;
1311 $safe_terms =~ s{'}{ }go;
1313 my $recs = $search->request(
1314 'open-ils.search.biblio.multiclass.query' => {
1315 org_unit => $org_unit->[0]->id,
1319 sort_dir => $sortdir,
1320 default_class => $class,
1321 ($lang ? ( 'language' => $lang ) : ()),
1322 } => $safe_terms => 1
1325 $log->debug("Hits for [$terms]: $recs->{count}");
1327 my $feed = create_record_feed(
1330 [ map { $_->[0] } @{$recs->{ids}} ],
1337 $log->debug("Feed created...");
1341 $feed->search($safe_terms);
1342 $feed->class($class);
1344 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1346 $feed->creator($host);
1349 $feed->_create_node(
1350 $feed->{item_xpath},
1351 'http://a9.com/-/spec/opensearch/1.1/',
1356 $feed->_create_node(
1357 $feed->{item_xpath},
1358 'http://a9.com/-/spec/opensearch/1.1/',
1363 $feed->_create_node(
1364 $feed->{item_xpath},
1365 'http://a9.com/-/spec/opensearch/1.1/',
1370 $log->debug("...basic feed data added...");
1374 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1375 'application/opensearch+xml'
1376 ) if ($offset + $limit < $recs->{count});
1380 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1381 'application/opensearch+xml'
1386 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1387 'application/opensearch+xml'
1392 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1393 'application/rss+xml'
1398 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1399 'application/atom+xml'
1404 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1410 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1414 $feed->link( 'unapi-server' => $unapi);
1416 $log->debug("...feed links added...");
1420 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1421 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1425 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1426 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1428 $log->debug("...and feed returned.");
1430 return Apache2::Const::OK;
1433 sub create_record_feed {
1436 my $records = shift;
1439 my $lib = uc(shift()) || '-';
1446 my $base = $cgi->url;
1447 my $host = $cgi->virtual_host || $cgi->server_name;
1449 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1453 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1455 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1457 $type =~ s/(-full|-uris)$//o;
1459 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1460 $feed->base($base) if ($flesh);
1461 $feed->unapi($unapi) if ($flesh);
1463 $type = 'atom' if ($type eq 'html');
1464 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1466 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1469 for my $record (@$records) {
1470 next unless($record);
1472 #my $rec = $record->id;
1475 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1476 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1477 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1478 $item_tag .= "/$depth" if (defined($depth));
1480 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1482 my $xml = $supercat->request(
1483 "open-ils.supercat.$search.$type.retrieve",
1488 my $node = $feed->add_item($xml);
1492 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1493 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1494 while ( !$r->complete ) {
1495 $xml .= join('', map {$_->content} $r->recv);
1497 $xml .= join('', map {$_->content} $r->recv);
1498 $node->add_holdings($xml);
1501 $node->id($item_tag);
1502 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1503 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1504 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1505 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1506 $node->link('unapi-id' => $item_tag) if ($flesh);
1514 return Apache2::Const::DECLINED if (-e $apache->filename);
1517 my $year = (gmtime())[5] + 1900;
1519 my $host = $cgi->virtual_host || $cgi->server_name;
1522 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1523 my $rel_name = $cgi->url(-relative=>1);
1524 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1527 my $url = $cgi->url(-path_info=>$add_path);
1528 my $root = (split 'browse', $url)[0];
1529 my $base = (split 'browse', $url)[0] . 'browse';
1530 my $unapi = (split 'browse', $url)[0] . 'unapi';
1532 my $path = $cgi->path_info;
1535 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1536 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1538 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1540 my $status = [$cgi->param('status')];
1541 my $cpLoc = [$cgi->param('copyLocation')];
1542 $site ||= $cgi->param('searchOrg');
1543 $page ||= $cgi->param('startPage') || 0;
1544 $page_size ||= $cgi->param('count') || 9;
1546 $page = 0 if ($page !~ /^-?\d+$/);
1547 $page_size = 9 if $page_size !~ /^\d+$/;
1549 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1550 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1552 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1553 warn "something's wrong...";
1554 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1558 $string = decode_utf8($string);
1559 $string =~ s/\+/ /go;
1563 if ($axis =~ /^authority/) {
1564 $tree = $supercat->request(
1565 "open-ils.supercat.authority.browse.by_axis",
1572 $tree = $supercat->request(
1573 "open-ils.supercat.$axis.browse",
1583 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1585 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1586 print $header.$content;
1587 return Apache2::Const::OK;
1590 sub string_startwith {
1592 return Apache2::Const::DECLINED if (-e $apache->filename);
1595 my $year = (gmtime())[5] + 1900;
1597 my $host = $cgi->virtual_host || $cgi->server_name;
1600 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1601 my $rel_name = $cgi->url(-relative=>1);
1602 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1605 my $url = $cgi->url(-path_info=>$add_path);
1606 my $root = (split 'startwith', $url)[0];
1607 my $base = (split 'startwith', $url)[0] . 'startwith';
1608 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1610 my $path = $cgi->path_info;
1613 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1614 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1616 my $status = [$cgi->param('status')];
1617 my $cpLoc = [$cgi->param('copyLocation')];
1618 $site ||= $cgi->param('searchOrg');
1619 $page ||= $cgi->param('startPage') || 0;
1620 $page_size ||= $cgi->param('count') || 9;
1622 $page = 0 if ($page !~ /^-?\d+$/);
1623 $page_size = 9 if $page_size !~ /^\d+$/;
1625 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1626 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1628 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1629 warn "something's wrong...";
1630 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1634 $string = decode_utf8($string);
1635 $string =~ s/\+/ /go;
1639 if ($axis =~ /^authority/) {
1640 $tree = $supercat->request(
1641 "open-ils.supercat.authority.startwith.by_axis",
1648 $tree = $supercat->request(
1649 "open-ils.supercat.$axis.startwith",
1659 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1661 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1662 print $header.$content;
1663 return Apache2::Const::OK;
1666 sub item_age_browse {
1668 return Apache2::Const::DECLINED if (-e $apache->filename);
1671 my $year = (gmtime())[5] + 1900;
1673 my $host = $cgi->virtual_host || $cgi->server_name;
1676 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1677 my $rel_name = $cgi->url(-relative=>1);
1678 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1681 my $url = $cgi->url(-path_info=>$add_path);
1682 my $root = (split 'browse', $url)[0];
1683 my $base = (split 'browse', $url)[0] . 'browse';
1684 my $unapi = (split 'browse', $url)[0] . 'unapi';
1686 my $path = $cgi->path_info;
1689 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1690 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1692 unless ($axis eq 'item-age') {
1693 warn "something's wrong...";
1694 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1698 my $status = [$cgi->param('status')];
1699 my $cpLoc = [$cgi->param('copyLocation')];
1700 $site ||= $cgi->param('searchOrg') || '-';
1701 $page ||= $cgi->param('startPage') || 1;
1702 $page_size ||= $cgi->param('count') || 10;
1704 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1705 $page_size = 10 if $page_size !~ /^\d+$/;
1707 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1708 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1710 my $recs = $supercat->request(
1711 "open-ils.supercat.new_book_list",
1719 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1721 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1722 print $header.$content;
1723 return Apache2::Const::OK;
1726 our %qualifier_ids = (
1727 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1728 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1729 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1733 # Our authority search options are currently pretty impoverished;
1734 # just right-truncated string match on a few categories, or by
1736 our %nested_auth_qualifier_map = (
1738 id => { index => 'id', title => 'Record number'},
1739 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1740 title => { index => 'title', title => 'Uniform title'},
1741 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1742 topic => { index => 'topic', title => 'Topical term'},
1746 my $base_explain = <<XML;
1748 id="evergreen-sru-explain-full"
1749 authoritative="true"
1750 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1751 xmlns="http://explain.z3950.org/dtd/2.0/">
1752 <serverInfo transport="http" protocol="SRU" version="1.1">
1759 <title primary="true"/>
1760 <description primary="true"/>
1764 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1769 identifier="info:srw/schema/1/marcxml-v1.1"
1770 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1774 <title>MARC21Slim (marcxml)</title>
1779 <default type="numberOfRecords">10</default>
1780 <default type="contextSet">eg</default>
1781 <default type="index">keyword</default>
1782 <default type="relation">all</default>
1783 <default type="sortSchema">marcxml</default>
1784 <default type="retrieveSchema">marcxml</default>
1785 <setting type="maximumRecords">50</setting>
1786 <supports type="relationModifier">relevant</supports>
1787 <supports type="relationModifier">stem</supports>
1788 <supports type="relationModifier">fuzzy</supports>
1789 <supports type="relationModifier">word</supports>
1800 my $req = SRU::Request->newFromCGI( $cgi );
1801 my $resp = SRU::Response->newFromRequest( $req );
1803 # Find the org_unit shortname, if passed as part of the URL
1804 # http://example.com/opac/extras/sru/SHORTNAME
1805 my $url = $cgi->path_info;
1806 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1808 if ( $resp->type eq 'searchRetrieve' ) {
1810 # Older versions of Debian packages returned terms to us double-encoded,
1811 # so we had to forcefully double-decode them a second time with
1812 # an outer decode('utf8', $string) call; this seems to be resolved with
1813 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1814 my $cql_query = decode_utf8($req->query);
1815 my $search_string = decode_utf8($req->cql->toEvergreen);
1817 # Ensure the search string overrides the default site
1818 if ($shortname and $search_string !~ m#site:#) {
1819 $search_string .= " site:$shortname";
1822 my $offset = $req->startRecord;
1823 $offset-- if ($offset);
1826 my $limit = $req->maximumRecords;
1829 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1831 my $recs = $search->request(
1832 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1835 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1837 foreach my $record (@$bre) {
1838 my $marcxml = $record->marc;
1839 # Make the beast conform to a VDX-supported format
1840 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1841 # Trying to implement LIBSOL_852_A format; so much for standards
1843 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1844 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1846 # Force record leader to 'a' as our data is always UTF8
1847 # Avoids marc8_to_utf8 from being invoked with horrible results
1848 # on the off-chance the record leader isn't correct
1849 my $ldr = $marc->leader;
1850 substr($ldr, 9, 1, 'a');
1851 $marc->leader($ldr);
1853 # Expects the record ID in the 001
1854 $marc->delete_field($_) for ($marc->field('001'));
1855 if (!$marc->field('001')) {
1856 $marc->insert_fields_ordered(
1857 MARC::Field->new( '001', $record->id )
1860 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1861 foreach my $cn (keys %$bib_holdings) {
1862 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1863 $marc->insert_fields_ordered(
1866 a => $cp->{'location'},
1867 b => $bib_holdings->{$cn}->{'owning_lib'},
1869 d => $cp->{'circlib'},
1870 g => $cp->{'barcode'},
1871 n => $cp->{'status'},
1877 # Ensure the data is encoded as UTF8 before we hand it off
1878 $marcxml = encode_utf8($marc->as_xml_record());
1879 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1883 SRU::Response::Record->new(
1884 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1885 recordData => $marcxml,
1886 recordPosition => ++$offset
1891 $resp->numberOfRecords($recs->{count});
1893 } elsif ( $resp->type eq 'explain' ) {
1894 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1896 \%OpenILS::WWW::SuperCat::qualifier_ids
1900 SRU::Response::Record->new(
1901 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1902 recordData => $ex_doc
1907 print $cgi->header( -type => 'application/xml' );
1908 print $U->entityize($resp->asXML) . "\n";
1909 return Apache2::Const::OK;
1914 package CQL::BooleanNode;
1918 my $left = $self->left();
1919 my $right = $self->right();
1920 my $leftStr = $left->toEvergreen;
1921 my $rightStr = $right->toEvergreen();
1923 my $op = '||' if uc $self->op() eq 'OR';
1926 return "$leftStr $rightStr";
1929 sub toEvergreenAuth {
1930 return toEvergreen(shift);
1933 package CQL::TermNode;
1937 my $qualifier = $self->getQualifier();
1938 my $term = $self->getTerm();
1939 my $relation = $self->getRelation();
1943 my ($qset, $qname) = split(/\./, $qualifier);
1945 if ( exists($qualifier_map{$qset}{$qname}) ) {
1946 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1947 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1950 my @modifiers = $relation->getModifiers();
1952 my $base = $relation->getBase();
1953 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1956 foreach my $m ( @modifiers ) {
1957 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1963 $quote_it = 0 if ( $base eq 'all' );
1964 $term = maybeQuote($term) if $quote_it;
1967 croak( "Evergreen doesn't support the $base relations" );
1975 return "$qualifier:$term";
1978 sub toEvergreenAuth {
1980 my $qualifier = $self->getQualifier();
1981 my $term = $self->getTerm();
1982 my $relation = $self->getRelation();
1986 my ($qset, $qname) = split(/\./, $qualifier);
1988 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1989 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1990 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1993 return { qualifier => $qualifier, term => $term };
1998 sub sru_auth_search {
2001 my $req = SRU::Request->newFromCGI( $cgi );
2002 my $resp = SRU::Response->newFromRequest( $req );
2004 if ( $resp->type eq 'searchRetrieve' ) {
2005 return_auth_response($cgi, $req, $resp);
2006 } elsif ( $resp->type eq 'explain' ) {
2007 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2008 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2009 \%OpenILS::WWW::SuperCat::qualifier_ids
2013 print $cgi->header( -type => 'application/xml' );
2014 print $U->entityize($resp->asXML) . "\n";
2015 return Apache2::Const::OK;
2018 sub explain_header {
2021 my $host = $cgi->virtual_host || $cgi->server_name;
2024 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2025 my $rel_name = $cgi->url(-relative=>1);
2026 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2028 my $base = $cgi->url(-base=>1);
2029 my $url = $cgi->url(-path_info=>$add_path);
2030 $url =~ s/^$base\///o;
2032 my $doc = $parser->parse_string($base_explain);
2033 my $e = $doc->documentElement;
2034 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2035 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2036 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2041 sub return_sru_explain {
2042 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2044 $index_map ||= \%qualifier_map;
2046 my ($doc, $e) = explain_header($cgi);
2047 for my $name ( keys %{$index_map} ) {
2049 my $identifier = $qualifier_ids->{ $name };
2051 next unless $identifier;
2053 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2054 $set_node->setAttribute( identifier => $identifier );
2055 $set_node->setAttribute( name => $name );
2057 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2058 for my $index ( sort keys %{$index_map->{$name}} ) {
2059 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2061 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2062 $map_node->appendChild( $name_node );
2064 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2066 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2067 $index_node->appendChild( $title_node );
2068 $index_node->appendChild( $map_node );
2070 $index_node->setAttribute( id => "$name.$index" );
2071 $title_node->appendText($index_map->{$name}{$index}{'title'});
2072 $name_node->setAttribute( set => $name );
2073 $name_node->appendText($index_map->{$name}{$index}{'index'});
2075 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2079 $$explain = $e->toString;
2083 SRU::Response::Record->new(
2084 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2085 recordData => $$explain
2091 sub return_auth_response {
2092 my ($cgi, $req, $resp) = @_;
2094 my $cql_query = decode_utf8($req->query);
2095 my $search = $req->cql->toEvergreenAuth;
2097 my $qualifier = decode_utf8($search->{qualifier});
2098 my $term = decode_utf8($search->{term});
2100 $log->info("SRU NAF search string [$cql_query] converted to "
2101 . "[$qualifier:$term]\n");
2103 my $page_size = $req->maximumRecords;
2106 # startwith deals with pages, so convert startRecord to a page number
2107 my $page = ($req->startRecord / $page_size) || 0;
2110 if ($qualifier eq "id") {
2111 $recs = [ int($term) ];
2113 $recs = $supercat->request(
2114 "open-ils.supercat.authority.startwith.by_axis",
2122 my $record_position = $req->startRecord;
2123 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2124 foreach my $record (@$recs) {
2125 my $marcxml = $cstore->request(
2126 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2130 SRU::Response::Record->new(
2131 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2132 recordData => $marcxml,
2133 recordPosition => ++$record_position
2138 $resp->numberOfRecords(scalar(@$recs));
2141 =head2 get_ou($org_unit)
2143 Returns an aou object for a given actor.org_unit shortname or ID.
2148 my $org = shift || '-';
2152 $org_unit = $actor->request(
2153 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2155 } elsif ($org !~ /^\d+$/o) {
2156 $org_unit = $actor->request(
2157 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2160 $org_unit = $actor->request(
2161 'open-ils.actor.org_unit_list.search' => id => $org