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->creator($host);
1030 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1031 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1032 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1033 $feed->link(unapi => $unapi);
1037 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1038 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1043 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1044 print $U->entityize($feed->toString) . "\n";
1046 return Apache2::Const::OK;
1051 return Apache2::Const::DECLINED if (-e $apache->filename);
1055 my $year = (gmtime())[5] + 1900;
1056 my $host = $cgi->virtual_host || $cgi->server_name;
1059 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1060 my $rel_name = $cgi->url(-relative=>1);
1061 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1064 my $url = $cgi->url(-path_info=>$add_path);
1065 my $root = (split 'feed', $url)[0];
1066 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1067 my $unapi = (split 'feed', $url)[0] . 'unapi';
1069 my $skin = $cgi->param('skin') || 'default';
1070 my $locale = $cgi->param('locale') || 'en-US';
1071 my $org = $cgi->param('searchOrg');
1073 # Enable localized results of copy status, etc
1074 $supercat->session_locale($locale);
1076 my $org_unit = get_ou($org);
1077 my $scope = "l=" . $org_unit->[0]->id . "&";
1079 my $path = $cgi->path_info;
1080 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1082 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1084 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1085 my $flesh_feed = parse_feed_type($type);
1088 $limit = 10 if $limit !~ /^\d+$/;
1090 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1092 #if ($type eq 'opac') {
1093 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1094 # join('&', map { "rl=" . $_ } @$list) .
1099 my $search = 'record';
1100 if ($rtype eq 'authority') {
1101 $search = 'authority';
1103 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1107 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1109 $feed->title("$limit most recent $rtype ${axis}s");
1112 $feed->creator($host);
1115 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1116 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1117 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1118 $feed->link(unapi => $unapi);
1122 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1123 join('&', map { 'rl=' . $_} @$list ),
1128 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1129 print $U->entityize($feed->toString) . "\n";
1131 return Apache2::Const::OK;
1134 sub opensearch_osd {
1135 my $version = shift;
1140 if ($version eq '1.0') {
1142 Content-type: application/opensearchdescription+xml; charset=utf-8
1144 <?xml version="1.0" encoding="UTF-8"?>
1145 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1146 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1147 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1148 <ShortName>$lib</ShortName>
1149 <LongName>Search $lib</LongName>
1150 <Description>Search the $lib OPAC by $class.</Description>
1151 <Tags>$lib book library</Tags>
1152 <SampleSearch>harry+potter</SampleSearch>
1153 <Developer>Mike Rylander for GPLS/PINES</Developer>
1154 <Contact>feedback\@open-ils.org</Contact>
1155 <SyndicationRight>open</SyndicationRight>
1156 <AdultContent>false</AdultContent>
1157 </OpenSearchDescription>
1161 Content-type: application/opensearchdescription+xml; charset=utf-8
1163 <?xml version="1.0" encoding="UTF-8"?>
1164 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1165 <ShortName>$lib</ShortName>
1166 <Description>Search the $lib OPAC by $class.</Description>
1167 <Tags>$lib book library</Tags>
1168 <Url type="application/rss+xml"
1169 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1170 <Url type="application/atom+xml"
1171 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1172 <Url type="application/x-mods3+xml"
1173 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1174 <Url type="application/x-mods+xml"
1175 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1176 <Url type="application/x-marcxml+xml"
1177 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1178 <Url type="text/html"
1179 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1180 <LongName>Search $lib</LongName>
1181 <Query role="example" searchTerms="harry+potter" />
1182 <Developer>Mike Rylander for GPLS/PINES</Developer>
1183 <Contact>feedback\@open-ils.org</Contact>
1184 <SyndicationRight>open</SyndicationRight>
1185 <AdultContent>false</AdultContent>
1186 <Language>en-US</Language>
1187 <OutputEncoding>UTF-8</OutputEncoding>
1188 <InputEncoding>UTF-8</InputEncoding>
1189 </OpenSearchDescription>
1193 return Apache2::Const::OK;
1196 sub opensearch_feed {
1198 return Apache2::Const::DECLINED if (-e $apache->filename);
1201 my $year = (gmtime())[5] + 1900;
1203 my $host = $cgi->virtual_host || $cgi->server_name;
1206 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1207 my $rel_name = $cgi->url(-relative=>1);
1208 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1211 my $url = $cgi->url(-path_info=>$add_path);
1212 my $root = (split 'opensearch', $url)[0];
1213 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1214 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1216 my $path = $cgi->path_info;
1217 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1219 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1225 if (!$lib || $lib eq '-') {
1226 $lib = $actor->request(
1227 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1228 )->gather(1)->[0]->shortname;
1231 if ($class eq '-') {
1235 return opensearch_osd($version, $lib, $class, $base);
1239 my $page = $cgi->param('startPage') || 1;
1240 my $offset = $cgi->param('startIndex') || 1;
1241 my $limit = $cgi->param('count') || 10;
1243 $page = 1 if ($page !~ /^\d+$/);
1244 $offset = 1 if ($offset !~ /^\d+$/);
1245 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1248 $offset = ($page - 1) * $limit;
1253 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1254 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1256 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1257 $lang = '' if ($lang eq '*');
1259 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1261 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1264 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1265 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1267 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1270 $type = $cgi->param('responseType') if $cgi->param('responseType');
1273 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1277 my $kwt = $cgi->param('kw');
1278 my $tit = $cgi->param('ti');
1279 my $aut = $cgi->param('au');
1280 my $sut = $cgi->param('su');
1281 my $set = $cgi->param('se');
1283 $terms .= " " if ($terms && $kwt);
1284 $terms .= "keyword: $kwt" if ($kwt);
1285 $terms .= " " if ($terms && $tit);
1286 $terms .= "title: $tit" if ($tit);
1287 $terms .= " " if ($terms && $aut);
1288 $terms .= "author: $aut" if ($aut);
1289 $terms .= " " if ($terms && $sut);
1290 $terms .= "subject: $sut" if ($sut);
1291 $terms .= " " if ($terms && $set);
1292 $terms .= "series: $set" if ($set);
1294 if ($version eq '1.0') {
1296 } elsif ($type eq '-') {
1299 my $flesh_feed = parse_feed_type($type);
1301 $terms = decode_utf8($terms);
1302 $lang = 'eng' if ($lang eq 'en-US');
1304 $log->debug("OpenSearch terms: $terms");
1306 my $org_unit = get_ou($org);
1308 # Apostrophes break search and get indexed as spaces anyway
1309 my $safe_terms = $terms;
1310 $safe_terms =~ s{'}{ }go;
1312 my $recs = $search->request(
1313 'open-ils.search.biblio.multiclass.query' => {
1314 org_unit => $org_unit->[0]->id,
1318 sort_dir => $sortdir,
1319 default_class => $class,
1320 ($lang ? ( 'language' => $lang ) : ()),
1321 } => $safe_terms => 1
1324 $log->debug("Hits for [$terms]: $recs->{count}");
1326 my $feed = create_record_feed(
1329 [ map { $_->[0] } @{$recs->{ids}} ],
1336 $log->debug("Feed created...");
1340 $feed->search($safe_terms);
1341 $feed->class($class);
1343 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1345 $feed->creator($host);
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 $feed->_create_node(
1363 $feed->{item_xpath},
1364 'http://a9.com/-/spec/opensearch/1.1/',
1369 $log->debug("...basic feed data added...");
1373 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1374 'application/opensearch+xml'
1375 ) if ($offset + $limit < $recs->{count});
1379 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1380 'application/opensearch+xml'
1385 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1386 'application/opensearch+xml'
1391 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1392 'application/rss+xml'
1397 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1398 'application/atom+xml'
1403 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1409 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1413 $feed->link( 'unapi-server' => $unapi);
1415 $log->debug("...feed links added...");
1419 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1420 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1424 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1425 print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1427 $log->debug("...and feed returned.");
1429 return Apache2::Const::OK;
1432 sub create_record_feed {
1435 my $records = shift;
1438 my $lib = uc(shift()) || '-';
1445 my $base = $cgi->url;
1446 my $host = $cgi->virtual_host || $cgi->server_name;
1448 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1452 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1454 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1456 $type =~ s/(-full|-uris)$//o;
1458 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1459 $feed->base($base) if ($flesh);
1460 $feed->unapi($unapi) if ($flesh);
1462 $type = 'atom' if ($type eq 'html');
1463 $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1465 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1468 for my $record (@$records) {
1469 next unless($record);
1471 #my $rec = $record->id;
1474 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1475 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1476 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1477 $item_tag .= "/$depth" if (defined($depth));
1479 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1481 my $xml = $supercat->request(
1482 "open-ils.supercat.$search.$type.retrieve",
1487 my $node = $feed->add_item($xml);
1491 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1492 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1493 while ( !$r->complete ) {
1494 $xml .= join('', map {$_->content} $r->recv);
1496 $xml .= join('', map {$_->content} $r->recv);
1497 $node->add_holdings($xml);
1500 $node->id($item_tag);
1501 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1502 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1503 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1504 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1505 $node->link('unapi-id' => $item_tag) if ($flesh);
1513 return Apache2::Const::DECLINED if (-e $apache->filename);
1516 my $year = (gmtime())[5] + 1900;
1518 my $host = $cgi->virtual_host || $cgi->server_name;
1521 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1522 my $rel_name = $cgi->url(-relative=>1);
1523 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1526 my $url = $cgi->url(-path_info=>$add_path);
1527 my $root = (split 'browse', $url)[0];
1528 my $base = (split 'browse', $url)[0] . 'browse';
1529 my $unapi = (split 'browse', $url)[0] . 'unapi';
1531 my $path = $cgi->path_info;
1534 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1535 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1537 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1539 my $status = [$cgi->param('status')];
1540 my $cpLoc = [$cgi->param('copyLocation')];
1541 $site ||= $cgi->param('searchOrg');
1542 $page ||= $cgi->param('startPage') || 0;
1543 $page_size ||= $cgi->param('count') || 9;
1545 $page = 0 if ($page !~ /^-?\d+$/);
1546 $page_size = 9 if $page_size !~ /^\d+$/;
1548 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1549 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1551 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1552 warn "something's wrong...";
1553 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1557 $string = decode_utf8($string);
1558 $string =~ s/\+/ /go;
1562 if ($axis =~ /^authority/) {
1563 $tree = $supercat->request(
1564 "open-ils.supercat.authority.browse.by_axis",
1571 $tree = $supercat->request(
1572 "open-ils.supercat.$axis.browse",
1582 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1584 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1585 print $header.$content;
1586 return Apache2::Const::OK;
1589 sub string_startwith {
1591 return Apache2::Const::DECLINED if (-e $apache->filename);
1594 my $year = (gmtime())[5] + 1900;
1596 my $host = $cgi->virtual_host || $cgi->server_name;
1599 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1600 my $rel_name = $cgi->url(-relative=>1);
1601 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1604 my $url = $cgi->url(-path_info=>$add_path);
1605 my $root = (split 'startwith', $url)[0];
1606 my $base = (split 'startwith', $url)[0] . 'startwith';
1607 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1609 my $path = $cgi->path_info;
1612 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1613 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1615 my $status = [$cgi->param('status')];
1616 my $cpLoc = [$cgi->param('copyLocation')];
1617 $site ||= $cgi->param('searchOrg');
1618 $page ||= $cgi->param('startPage') || 0;
1619 $page_size ||= $cgi->param('count') || 9;
1621 $page = 0 if ($page !~ /^-?\d+$/);
1622 $page_size = 9 if $page_size !~ /^\d+$/;
1624 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1625 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1627 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1628 warn "something's wrong...";
1629 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1633 $string = decode_utf8($string);
1634 $string =~ s/\+/ /go;
1638 if ($axis =~ /^authority/) {
1639 $tree = $supercat->request(
1640 "open-ils.supercat.authority.startwith.by_axis",
1647 $tree = $supercat->request(
1648 "open-ils.supercat.$axis.startwith",
1658 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1660 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1661 print $header.$content;
1662 return Apache2::Const::OK;
1665 sub item_age_browse {
1667 return Apache2::Const::DECLINED if (-e $apache->filename);
1670 my $year = (gmtime())[5] + 1900;
1672 my $host = $cgi->virtual_host || $cgi->server_name;
1675 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1676 my $rel_name = $cgi->url(-relative=>1);
1677 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1680 my $url = $cgi->url(-path_info=>$add_path);
1681 my $root = (split 'browse', $url)[0];
1682 my $base = (split 'browse', $url)[0] . 'browse';
1683 my $unapi = (split 'browse', $url)[0] . 'unapi';
1685 my $path = $cgi->path_info;
1688 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1689 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1691 unless ($axis eq 'item-age') {
1692 warn "something's wrong...";
1693 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1697 my $status = [$cgi->param('status')];
1698 my $cpLoc = [$cgi->param('copyLocation')];
1699 $site ||= $cgi->param('searchOrg') || '-';
1700 $page ||= $cgi->param('startPage') || 1;
1701 $page_size ||= $cgi->param('count') || 10;
1703 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1704 $page_size = 10 if $page_size !~ /^\d+$/;
1706 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1707 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1709 my $recs = $supercat->request(
1710 "open-ils.supercat.new_book_list",
1718 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1720 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1721 print $header.$content;
1722 return Apache2::Const::OK;
1725 our %qualifier_ids = (
1726 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1727 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1728 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1732 # Our authority search options are currently pretty impoverished;
1733 # just right-truncated string match on a few categories, or by
1735 our %nested_auth_qualifier_map = (
1737 id => { index => 'id', title => 'Record number'},
1738 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1739 title => { index => 'title', title => 'Uniform title'},
1740 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1741 topic => { index => 'topic', title => 'Topical term'},
1745 my $base_explain = <<XML;
1747 id="evergreen-sru-explain-full"
1748 authoritative="true"
1749 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1750 xmlns="http://explain.z3950.org/dtd/2.0/">
1751 <serverInfo transport="http" protocol="SRU" version="1.1">
1758 <title primary="true"/>
1759 <description primary="true"/>
1763 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1768 identifier="info:srw/schema/1/marcxml-v1.1"
1769 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1773 <title>MARC21Slim (marcxml)</title>
1778 <default type="numberOfRecords">10</default>
1779 <default type="contextSet">eg</default>
1780 <default type="index">keyword</default>
1781 <default type="relation">all</default>
1782 <default type="sortSchema">marcxml</default>
1783 <default type="retrieveSchema">marcxml</default>
1784 <setting type="maximumRecords">50</setting>
1785 <supports type="relationModifier">relevant</supports>
1786 <supports type="relationModifier">stem</supports>
1787 <supports type="relationModifier">fuzzy</supports>
1788 <supports type="relationModifier">word</supports>
1799 my $req = SRU::Request->newFromCGI( $cgi );
1800 my $resp = SRU::Response->newFromRequest( $req );
1802 # Find the org_unit shortname, if passed as part of the URL
1803 # http://example.com/opac/extras/sru/SHORTNAME
1804 my $url = $cgi->path_info;
1805 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1807 if ( $resp->type eq 'searchRetrieve' ) {
1809 # Older versions of Debian packages returned terms to us double-encoded,
1810 # so we had to forcefully double-decode them a second time with
1811 # an outer decode('utf8', $string) call; this seems to be resolved with
1812 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1813 my $cql_query = decode_utf8($req->query);
1814 my $search_string = decode_utf8($req->cql->toEvergreen);
1816 # Ensure the search string overrides the default site
1817 if ($shortname and $search_string !~ m#site:#) {
1818 $search_string .= " site:$shortname";
1821 my $offset = $req->startRecord;
1822 $offset-- if ($offset);
1825 my $limit = $req->maximumRecords;
1828 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1830 my $recs = $search->request(
1831 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1834 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1836 foreach my $record (@$bre) {
1837 my $marcxml = $record->marc;
1838 # Make the beast conform to a VDX-supported format
1839 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1840 # Trying to implement LIBSOL_852_A format; so much for standards
1842 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1843 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1845 # Force record leader to 'a' as our data is always UTF8
1846 # Avoids marc8_to_utf8 from being invoked with horrible results
1847 # on the off-chance the record leader isn't correct
1848 my $ldr = $marc->leader;
1849 substr($ldr, 9, 1, 'a');
1850 $marc->leader($ldr);
1852 # Expects the record ID in the 001
1853 $marc->delete_field($_) for ($marc->field('001'));
1854 if (!$marc->field('001')) {
1855 $marc->insert_fields_ordered(
1856 MARC::Field->new( '001', $record->id )
1859 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1860 foreach my $cn (keys %$bib_holdings) {
1861 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1862 $marc->insert_fields_ordered(
1865 a => $cp->{'location'},
1866 b => $bib_holdings->{$cn}->{'owning_lib'},
1868 d => $cp->{'circlib'},
1869 g => $cp->{'barcode'},
1870 n => $cp->{'status'},
1876 # Ensure the data is encoded as UTF8 before we hand it off
1877 $marcxml = encode_utf8($marc->as_xml_record());
1878 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1882 SRU::Response::Record->new(
1883 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1884 recordData => $marcxml,
1885 recordPosition => ++$offset
1890 $resp->numberOfRecords($recs->{count});
1892 } elsif ( $resp->type eq 'explain' ) {
1893 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1895 \%OpenILS::WWW::SuperCat::qualifier_ids
1899 SRU::Response::Record->new(
1900 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1901 recordData => $ex_doc
1906 print $cgi->header( -type => 'application/xml' );
1907 print $U->entityize($resp->asXML) . "\n";
1908 return Apache2::Const::OK;
1913 package CQL::BooleanNode;
1917 my $left = $self->left();
1918 my $right = $self->right();
1919 my $leftStr = $left->toEvergreen;
1920 my $rightStr = $right->toEvergreen();
1922 my $op = '||' if uc $self->op() eq 'OR';
1925 return "$leftStr $rightStr";
1928 sub toEvergreenAuth {
1929 return toEvergreen(shift);
1932 package CQL::TermNode;
1936 my $qualifier = $self->getQualifier();
1937 my $term = $self->getTerm();
1938 my $relation = $self->getRelation();
1942 my ($qset, $qname) = split(/\./, $qualifier);
1944 if ( exists($qualifier_map{$qset}{$qname}) ) {
1945 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1946 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
1949 my @modifiers = $relation->getModifiers();
1951 my $base = $relation->getBase();
1952 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1955 foreach my $m ( @modifiers ) {
1956 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1962 $quote_it = 0 if ( $base eq 'all' );
1963 $term = maybeQuote($term) if $quote_it;
1966 croak( "Evergreen doesn't support the $base relations" );
1974 return "$qualifier:$term";
1977 sub toEvergreenAuth {
1979 my $qualifier = $self->getQualifier();
1980 my $term = $self->getTerm();
1981 my $relation = $self->getRelation();
1985 my ($qset, $qname) = split(/\./, $qualifier);
1987 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1988 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1989 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1992 return { qualifier => $qualifier, term => $term };
1997 sub sru_auth_search {
2000 my $req = SRU::Request->newFromCGI( $cgi );
2001 my $resp = SRU::Response->newFromRequest( $req );
2003 if ( $resp->type eq 'searchRetrieve' ) {
2004 return_auth_response($cgi, $req, $resp);
2005 } elsif ( $resp->type eq 'explain' ) {
2006 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2007 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2008 \%OpenILS::WWW::SuperCat::qualifier_ids
2012 print $cgi->header( -type => 'application/xml' );
2013 print $U->entityize($resp->asXML) . "\n";
2014 return Apache2::Const::OK;
2017 sub explain_header {
2020 my $host = $cgi->virtual_host || $cgi->server_name;
2023 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2024 my $rel_name = $cgi->url(-relative=>1);
2025 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2027 my $base = $cgi->url(-base=>1);
2028 my $url = $cgi->url(-path_info=>$add_path);
2029 $url =~ s/^$base\///o;
2031 my $doc = $parser->parse_string($base_explain);
2032 my $e = $doc->documentElement;
2033 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2034 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2035 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2040 sub return_sru_explain {
2041 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2043 $index_map ||= \%qualifier_map;
2045 my ($doc, $e) = explain_header($cgi);
2046 for my $name ( keys %{$index_map} ) {
2048 my $identifier = $qualifier_ids->{ $name };
2050 next unless $identifier;
2052 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2053 $set_node->setAttribute( identifier => $identifier );
2054 $set_node->setAttribute( name => $name );
2056 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2057 for my $index ( sort keys %{$index_map->{$name}} ) {
2058 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2060 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2061 $map_node->appendChild( $name_node );
2063 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2065 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2066 $index_node->appendChild( $title_node );
2067 $index_node->appendChild( $map_node );
2069 $index_node->setAttribute( id => "$name.$index" );
2070 $title_node->appendText($index_map->{$name}{$index}{'title'});
2071 $name_node->setAttribute( set => $name );
2072 $name_node->appendText($index_map->{$name}{$index}{'index'});
2074 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2078 $$explain = $e->toString;
2082 SRU::Response::Record->new(
2083 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2084 recordData => $$explain
2090 sub return_auth_response {
2091 my ($cgi, $req, $resp) = @_;
2093 my $cql_query = decode_utf8($req->query);
2094 my $search = $req->cql->toEvergreenAuth;
2096 my $qualifier = decode_utf8($search->{qualifier});
2097 my $term = decode_utf8($search->{term});
2099 $log->info("SRU NAF search string [$cql_query] converted to "
2100 . "[$qualifier:$term]\n");
2102 my $page_size = $req->maximumRecords;
2105 # startwith deals with pages, so convert startRecord to a page number
2106 my $page = ($req->startRecord / $page_size) || 0;
2109 if ($qualifier eq "id") {
2110 $recs = [ int($term) ];
2112 $recs = $supercat->request(
2113 "open-ils.supercat.authority.startwith.by_axis",
2121 my $record_position = $req->startRecord;
2122 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2123 foreach my $record (@$recs) {
2124 my $marcxml = $cstore->request(
2125 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2129 SRU::Response::Record->new(
2130 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2131 recordData => $marcxml,
2132 recordPosition => ++$record_position
2137 $resp->numberOfRecords(scalar(@$recs));
2140 =head2 get_ou($org_unit)
2142 Returns an aou object for a given actor.org_unit shortname or ID.
2147 my $org = shift || '-';
2151 $org_unit = $actor->request(
2152 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2154 } elsif ($org !~ /^\d+$/o) {
2155 $org_unit = $actor->request(
2156 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2159 $org_unit = $actor->request(
2160 'open-ils.actor.org_unit_list.search' => id => $org