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 my $authority_axis_re = qr/^authority\.(\w+)(\.refs)?$/;
41 my %extra_header_action_per_type = (
43 {"Content-Disposition" =>
44 sub { "attachment;filename=" . time . ".mrc"}}
48 $browse_types{call_number}{xml} = sub {
51 my $year = (gmtime())[5] + 1900;
54 $content .= "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>\n";
57 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
58 $cn_class =~ s/Fieldmapper-//gso;
60 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
61 my $cn_lib = $cn->owning_lib->shortname;
62 my $cn_label = $cn->label;
63 my $cn_prefix = $cn->prefix->label;
64 my $cn_suffix = $cn->suffix->label;
66 $cn_label =~ s/\n//gos;
67 $cn_label =~ s/&/&/go;
68 $cn_label =~ s/'/'/go;
69 $cn_label =~ s/</</go;
70 $cn_label =~ s/>/>/go;
72 $cn_prefix =~ s/\n//gos;
73 $cn_prefix =~ s/&/&/go;
74 $cn_prefix =~ s/'/'/go;
75 $cn_prefix =~ s/</</go;
76 $cn_prefix =~ s/>/>/go;
78 $cn_suffix =~ s/\n//gos;
79 $cn_suffix =~ s/&/&/go;
80 $cn_suffix =~ s/'/'/go;
81 $cn_suffix =~ s/</</go;
82 $cn_suffix =~ s/>/>/go;
84 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
85 $ou_class =~ s/Fieldmapper-//gso;
87 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
88 my $ou_name = $cn->owning_lib->name;
90 $ou_name =~ s/\n//gos;
91 $ou_name =~ s/'/'/go;
93 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
94 $rec_class =~ s/Fieldmapper-//gso;
96 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
98 $content .= "<volume id='$cn_tag' lib='$cn_lib' prefix='$cn_prefix' label='$cn_label' suffix='$cn_suffix'>\n";
99 $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
101 my $r_doc = $parser->parse_string($cn->record->marc);
102 $r_doc->documentElement->setAttribute( id => $rec_tag );
103 $content .= $U->entityize($r_doc->documentElement->toString);
105 $content .= "</volume>\n";
108 $content .= "</volumes>\n";
109 return ("Content-type: application/xml\n\n",$content);
113 $browse_types{call_number}{html} = sub {
118 if (!$cn_browse_xslt) {
119 $cn_browse_xslt = $parser->parse_file(
120 OpenSRF::Utils::SettingsClient
122 ->config_value( dirs => 'xsl' ).
125 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
128 my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
131 "Content-type: text/html\n\n",
133 $cn_browse_xslt->transform(
134 $parser->parse_string( $xml ),
149 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
151 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
152 Fieldmapper->import(IDL => $idl);
154 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
155 $actor = OpenSRF::AppSession->create('open-ils.actor');
156 $search = OpenSRF::AppSession->create('open-ils.search');
157 $parser = new XML::LibXML;
158 $xslt = new XML::LibXSLT;
160 $cn_browse_xslt = $parser->parse_file(
161 OpenSRF::Utils::SettingsClient
163 ->config_value( dirs => 'xsl' ).
167 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
169 %qualifier_map = %{$supercat
170 ->request("open-ils.supercat.biblio.search_aliases")
173 my %attribute_desc = (
174 site => 'Evergreen Site Code (shortname)',
175 sort => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
176 dir => 'Sort direction (asc|desc)',
177 available => 'Filter to available (true|false)',
180 # Append the non-search-alias attributes to the qualifier map
197 preferred_language_weight
198 preferred_language_multiplier
200 $qualifier_map{'eg'}{$_}{'index'} = $_;
201 if (exists $attribute_desc{$_}) {
202 $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
204 $qualifier_map{'eg'}{$_}{'title'} = $_;
209 ->request("open-ils.supercat.record.formats")
212 $list = [ map { (keys %$_)[0] } @$list ];
213 push @$list, 'htmlholdings','html', 'marctxt', 'ris';
215 for my $browse_axis ( qw/title author subject topic series item-age/ ) {
216 for my $record_browse_format ( @$list ) {
218 my $__f = $record_browse_format;
219 my $__a = $browse_axis;
221 $browse_types{$__a}{$__f} = sub {
222 my $record_list = shift;
225 my $real_format = shift || $__f;
230 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
231 my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
232 $feed->root( "$base/../" );
234 $feed->link( next => $next => $feed->type );
235 $feed->link( previous => $prev => $feed->type );
238 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
246 my $auth_axes = $supercat
247 ->request("open-ils.supercat.authority.browse_axis_list")
251 for my $axis ( @$auth_axes ) {
252 my $basic_axis = 'authority.' . $axis;
253 for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
256 my $__a = $browse_axis;
258 $browse_types{$__a}{$__f} = sub {
259 my $record_list = shift;
262 my $real_format = shift || $__f;
267 $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
268 my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
269 $feed->root( "$base/../" );
270 $feed->link( next => $next => $feed->type );
271 $feed->link( previous => $prev => $feed->type );
274 "Content-type: ". $feed->type ."; charset=utf-8\n\n",
281 return Apache2::Const::OK;
284 sub check_child_init() {
285 if (!defined $supercat || !defined $actor || !defined $search) {
286 # For some reason one (or more) of our appsessions is missing....
292 =head2 parse_feed_type($type)
294 Determines whether and how a given feed type needs to be "fleshed out"
295 with holdings information.
297 The feed type could end with the string "-full", in which case we want
298 to return call numbers, copies, and URIS.
300 Or the feed type could end with "-uris", in which case we want to return
301 call numbers and URIS.
303 Otherwise, we won't return any holdings.
307 sub parse_feed_type {
308 my $type = shift || '';
310 if ($type =~ /-full$/o) {
314 if ($type =~ /-uris$/o) {
318 # Otherwise, we'll return just the facts, ma'am
322 =head2 supercat_format($format_hashref, $format_type)
324 Given a reference to a hash containing the namespace_uri,
325 docs, and schema location attributes for a set of formats,
326 generate the XML description required by the supercat service.
328 We derive the base type from the format type so that we do not
329 have to populate the hash with redundant information.
333 sub supercat_format {
337 (my $base_type = $type) =~ s/(-full|-uris)$//o;
339 my $format = "<format><name>$type</name><type>application/xml</type>";
341 for my $part ( qw/namespace_uri docs schema_location/ ) {
342 $format .= "<$part>$$h{$base_type}{$part}</$part>"
343 if ($$h{$base_type}{$part});
346 $format .= '</format>';
351 =head2 unapi_format($format_hashref, $format_type)
353 Given a reference to a hash containing the namespace_uri,
354 docs, and schema location attributes for a set of formats,
355 generate the XML description required by the supercat service.
357 We derive the base type from the format type so that we do not
358 have to populate the hash with redundant information.
366 (my $base_type = $type) =~ s/(-full|-uris)$//o;
368 my $format = "<format name='$type' type='application/xml'";
370 for my $part ( qw/namespace_uri docs schema_location/ ) {
371 $format .= " $part='$$h{$base_type}{$part}'"
372 if ($$h{$base_type}{$part});
381 # Return a list of strings suitable for printing on STDOUT as HTTP headers.
382 sub extra_headers_per_type_to_string {
384 if (my $list = $extra_header_action_per_type{$type}) {
386 my $str = (keys(%$_))[0] . ": ";
387 my $value = (values(%$_))[0];
388 if (ref $value eq 'CODE') {
391 return $str . $value . "\n";
397 # Return key/value pairs suitable for feeding into CGI::header()
398 sub extra_headers_per_type_to_cgi {
401 if (my $list = $extra_header_action_per_type{$type}) {
403 my $key = (keys(%$_))[0];
404 my $value = (values(%$_))[0];
405 if (ref $value eq 'CODE') {
408 return $key => $value;
417 return Apache2::Const::DECLINED if (-e $apache->filename);
421 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
424 ->request("open-ils.supercat.oisbn", $isbn)
427 print "Content-type: application/xml; charset=utf-8\n\n";
428 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
430 unless (exists $$list{metarecord}) {
432 return Apache2::Const::OK;
435 print "<idlist metarecord='$$list{metarecord}'>\n";
437 for ( keys %{ $$list{record_list} } ) {
438 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
439 print " <isbn record='$_'>$o</isbn>\n"
444 return Apache2::Const::OK;
450 return Apache2::Const::DECLINED if (-e $apache->filename);
457 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
458 my $rel_name = $cgi->url(-relative=>1);
459 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
462 my $url = $cgi->url(-path_info=>$add_path);
463 my $root = (split 'unapi', $url)[0];
464 my $base = (split 'unapi', $url)[0] . 'unapi';
467 my $uri = $cgi->param('id') || '';
468 my $host = $cgi->virtual_host || $cgi->server_name;
470 my $skin = $cgi->param('skin') || 'default';
471 my $locale = $cgi->param('locale') || 'en-US';
473 # Enable localized results of copy status, etc
474 $supercat->session_locale($locale);
476 my $format = $cgi->param('format') || '';
477 my $flesh_feed = parse_feed_type($format);
478 (my $base_format = $format) =~ s/(-full|-uris)$//o;
479 my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
480 my $body = "Content-type: application/xml; charset=utf-8\n\n";
482 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
485 ($lib,$depth) = split('/', $4);
486 $type = 'metarecord' if ($1 =~ /^m/o);
487 $type = 'authority' if ($1 =~ /^authority/o);
491 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
494 ->request("open-ils.supercat.$type.formats")
497 if ($type eq 'record' or $type eq 'isbn') {
498 $body .= <<" FORMATS";
500 <format name='opac' type='text/html'/>
501 <format name='html' type='text/html'/>
502 <format name='htmlholdings' type='text/html'/>
503 <format name='holdings_xml' type='application/xml'/>
504 <format name='holdings_xml-full' type='application/xml'/>
505 <format name='html-full' type='text/html'/>
506 <format name='htmlholdings-full' type='text/html'/>
507 <format name='marctxt' type='text/plain'/>
508 <format name='ris' type='text/plain'/>
510 } elsif ($type eq 'metarecord') {
511 $body .= <<" FORMATS";
513 <format name='opac' type='text/html'/>
516 $body .= <<" FORMATS";
522 my ($type) = keys %$h;
523 $body .= unapi_format($h, $type);
525 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
526 $body .= unapi_format($h, "$type-full");
527 $body .= unapi_format($h, "$type-uris");
531 $body .= "</formats>\n";
535 ->request("open-ils.supercat.$type.formats")
540 ->request("open-ils.supercat.metarecord.formats")
544 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
545 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
547 $body .= <<" FORMATS";
549 <format name='opac' type='text/html'/>
550 <format name='html' type='text/html'/>
551 <format name='htmlholdings' type='text/html'/>
552 <format name='holdings_xml' type='application/xml'/>
553 <format name='holdings_xml-full' type='application/xml'/>
554 <format name='html-full' type='text/html'/>
555 <format name='htmlholdings-full' type='text/html'/>
556 <format name='marctxt' type='text/plain'/>
557 <format name='ris' type='text/plain'/>
562 my ($type) = keys %$h;
563 $body .= "\t" . unapi_format($h, $type);
565 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
566 $body .= "\t" . unapi_format($h, "$type-full");
567 $body .= "\t" . unapi_format($h, "$type-uris");
571 $body .= "</formats>\n";
575 return Apache2::Const::OK;
579 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
583 ($lib,$depth) = split('/', $4);
585 $type = 'metarecord' if ($scheme =~ /^metabib/o);
586 $type = 'isbn' if ($scheme =~ /^isbn/o);
587 $type = 'acp' if ($scheme =~ /^asset-copy/o);
588 $type = 'acn' if ($scheme =~ /^asset-call_number/o);
589 $type = 'auri' if ($scheme =~ /^asset-uri/o);
590 $type = 'authority' if ($scheme =~ /^authority/o);
591 $command = 'retrieve';
592 $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
593 $command = 'browse' if ($scheme =~ /^authority/);
597 $paging = [split ',', $paging];
602 if (!$lib || $lib eq '-') {
603 $lib = $actor->request(
604 'open-ils.actor.org_unit_list.search' => parent_ou => undef
605 )->gather(1)->[0]->shortname;
608 my ($lib_object,$lib_id,$ou_types,$lib_depth);
609 if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
610 $lib_object = $actor->request(
611 'open-ils.actor.org_unit_list.search' => shortname => $lib
613 $lib_id = $lib_object->id;
615 $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
616 $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
619 if ($command eq 'browse') {
620 print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
624 if ($type eq 'isbn') {
625 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
627 # Escape user input before display
628 $command = CGI::escapeHTML($command);
629 $id = CGI::escapeHTML($id);
630 $type = CGI::escapeHTML($type);
631 $format = CGI::escapeHTML(decode_utf8($format));
633 print "Content-type: text/html; charset=utf-8\n\n";
634 $apache->custom_response( 404, <<" HTML");
637 <title>Type [$type] with id [$id] not found!</title>
641 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
652 { (keys(%$_))[0] eq $base_format }
653 @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
655 { $_ eq $base_format }
656 qw/opac html htmlholdings marctxt ris holdings_xml/
658 # Escape user input before display
659 $format = CGI::escapeHTML($format);
660 $type = CGI::escapeHTML($type);
662 print "Content-type: text/html; charset=utf-8\n\n";
663 $apache->custom_response( 406, <<" HTML");
666 <title>Invalid format [$format] for type [$type]!</title>
670 <center>Sorry, format $format is not valid for type $type.</center>
677 if ($format eq 'opac') {
678 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
679 if ($type eq 'metarecord');
680 print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
681 if ($type eq 'record');
683 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
684 my $feed = create_record_feed(
695 # Escape user input before display
696 $command = CGI::escapeHTML($command);
697 $id = CGI::escapeHTML($id);
698 $type = CGI::escapeHTML($type);
699 $format = CGI::escapeHTML(decode_utf8($format));
701 print "Content-type: text/html; charset=utf-8\n\n";
702 $apache->custom_response( 404, <<" HTML");
705 <title>Type [$type] with id [$id] not found!</title>
709 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
717 $feed->creator($host);
719 $feed->link( unapi => $base) if ($flesh_feed);
721 print "Content-type: ". $feed->type ."; charset=utf-8\n";
723 print $_ for extra_headers_per_type_to_string($type);
725 print "\n", $feed->toString, "\n";
727 return Apache2::Const::OK;
730 my $method = "open-ils.supercat.$type.$base_format.$command";
732 push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
734 # for acn, acp, etc, the "lib" pathinfo position isn't useful.
735 # however, we can have it carry extra options like no_record! (comma separated)
736 push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
738 my $req = $supercat->request($method,@params);
739 my $data = $req->gather();
741 if ($req->failed || !$data) {
742 # Escape user input before display
743 $command = CGI::escapeHTML($command);
744 $id = CGI::escapeHTML($id);
745 $type = CGI::escapeHTML($type);
746 $format = CGI::escapeHTML(decode_utf8($format));
748 print "Content-type: text/html; charset=utf-8\n\n";
749 $apache->custom_response( 404, <<" HTML");
752 <title>$type $id not found!</title>
756 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
763 print "Content-type: application/xml; charset=utf-8\n\n";
765 # holdings_xml format comes back to us without an XML declaration
766 # and without being entityized; fix that here
767 if ($base_format eq 'holdings_xml') {
768 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
769 print $U->entityize($data);
771 while (my $c = $req->recv) {
772 print $U->entityize($c->content);
778 return Apache2::Const::OK;
784 return Apache2::Const::DECLINED if (-e $apache->filename);
791 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
792 my $rel_name = $cgi->url(-relative=>1);
793 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
796 my $url = $cgi->url(-path_info=>$add_path);
797 my $root = (split 'supercat', $url)[0];
798 my $base = (split 'supercat', $url)[0] . 'supercat';
799 my $unapi = (split 'supercat', $url)[0] . 'unapi';
801 my $host = $cgi->virtual_host || $cgi->server_name;
803 my $path = $cgi->path_info;
804 my ($id,$type,$format,$command) = reverse split '/', $path;
805 my $flesh_feed = parse_feed_type($format);
806 (my $base_format = $format) =~ s/(-full|-uris)$//o;
808 my $skin = $cgi->param('skin') || 'default';
809 my $locale = $cgi->param('locale') || 'en-US';
811 # Enable localized results of copy status, etc
812 $supercat->session_locale($locale);
814 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
815 print "Content-type: application/xml; charset=utf-8\n";
818 ->request("open-ils.supercat.$1.formats")
826 <type>text/html</type>
829 if ($1 eq 'record' or $1 eq 'isbn') {
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>
857 my ($type) = keys %$h;
858 print supercat_format($h, $type);
860 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
861 print supercat_format($h, "$type-full");
862 print supercat_format($h, "$type-uris");
867 print "</formats>\n";
869 return Apache2::Const::OK;
873 ->request("open-ils.supercat.record.formats")
878 ->request("open-ils.supercat.metarecord.formats")
882 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
883 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
888 <type>text/html</type>
891 <name>htmlholdings</name>
892 <type>text/html</type>
896 <type>text/html</type>
899 <name>htmlholdings-full</name>
900 <type>text/html</type>
903 <name>html-full</name>
904 <type>text/html</type>
908 <type>text/plain</type>
912 <type>text/plain</type>
916 my ($type) = keys %$h;
917 print supercat_format($h, $type);
919 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
920 print supercat_format($h, "$type-full");
921 print supercat_format($h, "$type-uris");
926 print "</formats>\n";
929 return Apache2::Const::OK;
932 if ($format eq 'opac') {
933 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
934 if ($type eq 'metarecord');
935 print "Location: /eg/opac/record/$id\n\n"
936 if ($type eq 'record');
939 } elsif ($base_format eq 'marc21') {
943 my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
945 print "Content-type: application/octet-stream\n";
946 print $_ for extra_headers_per_type_to_string($base_format);
947 print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
952 # Escape user input before display
953 $id = CGI::escapeHTML($id);
955 print "Content-type: text/html; charset=utf-8\n\n";
956 $apache->custom_response( 404, <<" HTML");
963 <center>Couldn't fetch $id as MARC21.</center>
970 return Apache2::Const::OK;
972 } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
973 my $feed = create_record_feed(
981 $feed->creator($host);
985 $feed->link( unapi => $base) if ($flesh_feed);
987 print "Content-type: ". $feed->type ."; charset=utf-8\n";
989 print $_ for extra_headers_per_type_to_string($type);
991 print "\n", $feed->toString, "\n";
993 return Apache2::Const::OK;
996 my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
1000 # Escape user input before display
1001 $command = CGI::escapeHTML($command);
1002 $id = CGI::escapeHTML($id);
1003 $type = CGI::escapeHTML($type);
1004 $format = CGI::escapeHTML(decode_utf8($format));
1006 print "Content-type: text/html; charset=utf-8\n\n";
1007 $apache->custom_response( 404, <<" HTML");
1010 <title>$type $id not found!</title>
1014 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
1021 print "Content-type: application/xml; charset=utf-8\n\n";
1022 print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
1024 return Apache2::Const::OK;
1030 return Apache2::Const::DECLINED if (-e $apache->filename);
1036 my $year = (gmtime())[5] + 1900;
1037 my $host = $cgi->virtual_host || $cgi->server_name;
1040 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1041 my $rel_name = $cgi->url(-relative=>1);
1042 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1045 my $url = $cgi->url(-path_info=>$add_path);
1046 my $root = (split 'feed', $url)[0] . '/';
1047 my $base = (split 'bookbag', $url)[0] . '/bookbag';
1048 my $unapi = (split 'feed', $url)[0] . '/unapi';
1050 my $skin = $cgi->param('skin') || 'default';
1051 my $locale = $cgi->param('locale') || 'en-US';
1052 my $org = $cgi->param('searchOrg');
1054 # Enable localized results of copy status, etc
1055 $supercat->session_locale($locale);
1057 my $org_unit = get_ou($org);
1058 my $scope = "l=" . $org_unit->[0]->id . "&";
1060 $root =~ s{(?<!http:)//}{//}go;
1061 $base =~ s{(?<!http:)//}{//}go;
1062 $unapi =~ s{(?<!http:)//}{//}go;
1064 my $path = $cgi->path_info;
1065 #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1067 my ($id,$type) = reverse split '/', $path;
1068 my $flesh_feed = parse_feed_type($type);
1070 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1071 return Apache2::Const::NOT_FOUND unless($bucket);
1073 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1074 if (lc($type) eq 'opac') {
1075 print "Location: /eg/opac/results?bookbag=$id\n\n";
1079 # last created first
1080 my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1082 my $feed = create_record_feed(
1085 [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1087 $org_unit->[0]->shortname,
1092 $feed->id($bucket_tag);
1094 $feed->title($bucket->name);
1095 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1096 $feed->creator($host);
1099 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1100 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1101 $feed->link(opac => $base . "/opac/$id" => 'text/html');
1102 $feed->link(OPAC => $base . "/opac/$id" => 'text/html');
1103 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1104 $feed->link(unapi => $unapi);
1106 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1107 print $feed->toString . "\n";
1109 return Apache2::Const::OK;
1114 return Apache2::Const::DECLINED if (-e $apache->filename);
1120 my $year = (gmtime())[5] + 1900;
1121 my $host = $cgi->virtual_host || $cgi->server_name;
1124 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1125 my $rel_name = $cgi->url(-relative=>1);
1126 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1129 my $url = $cgi->url(-path_info=>$add_path);
1130 my $root = (split 'feed', $url)[0];
1131 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1132 my $unapi = (split 'feed', $url)[0] . 'unapi';
1134 my $skin = $cgi->param('skin') || 'default';
1135 my $locale = $cgi->param('locale') || 'en-US';
1136 my $org = $cgi->param('searchOrg');
1138 # Enable localized results of copy status, etc
1139 $supercat->session_locale($locale);
1141 my $org_unit = get_ou($org);
1142 my $scope = "l=" . $org_unit->[0]->id . "&";
1144 my $path = $cgi->path_info;
1145 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1147 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1149 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1150 my $flesh_feed = parse_feed_type($type);
1153 $limit = 10 if $limit !~ /^\d+$/;
1155 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1157 if (lc($type) eq 'opac') {
1158 print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
1162 my $search = 'record';
1163 if ($rtype eq 'authority') {
1164 $search = 'authority';
1166 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1170 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1172 $feed->title("$limit most recent $rtype ${axis}s");
1175 $feed->creator($host);
1178 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1179 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1180 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1181 $feed->link(unapi => $unapi);
1185 "http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
1190 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1192 print $_ for extra_headers_per_type_to_string($type);
1194 print "\n", $feed->toString, "\n";
1196 return Apache2::Const::OK;
1199 sub opensearch_osd {
1200 my $version = shift;
1206 if ($version eq '1.0') {
1208 Content-type: application/opensearchdescription+xml; charset=utf-8
1210 <?xml version="1.0" encoding="UTF-8"?>
1211 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1212 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1213 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1214 <ShortName>$lib</ShortName>
1215 <LongName>Search $lib</LongName>
1216 <Description>Search the $lib OPAC by $class.</Description>
1217 <Tags>$lib book library</Tags>
1218 <SampleSearch>harry+potter</SampleSearch>
1219 <Developer>Mike Rylander for GPLS/PINES</Developer>
1220 <Contact>feedback\@open-ils.org</Contact>
1221 <SyndicationRight>open</SyndicationRight>
1222 <AdultContent>false</AdultContent>
1223 </OpenSearchDescription>
1227 Content-type: application/opensearchdescription+xml; charset=utf-8
1229 <?xml version="1.0" encoding="UTF-8"?>
1230 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1231 <ShortName>$lib</ShortName>
1232 <Description>Search the $lib OPAC by $class.</Description>
1233 <Tags>$lib book library</Tags>
1234 <Url type="application/rss+xml"
1235 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1236 <Url type="application/atom+xml"
1237 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1238 <Url type="application/x-mods3+xml"
1239 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1240 <Url type="application/x-mods+xml"
1241 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1242 <Url type="application/octet-stream"
1243 template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1244 <Url type="application/x-marcxml+xml"
1245 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1246 <Url type="text/html"
1247 template="https://$host/eg/opac/results?locg=$lib;query={searchTerms};page={startPage?};startIndex={startIndex?};count={count?};searchLang={language?}"/>
1248 <LongName>Search $lib</LongName>
1249 <Query role="example" searchTerms="harry+potter" />
1250 <Developer>Mike Rylander for GPLS/PINES</Developer>
1251 <Contact>feedback\@open-ils.org</Contact>
1252 <SyndicationRight>open</SyndicationRight>
1253 <AdultContent>false</AdultContent>
1254 <Language>en-US</Language>
1255 <OutputEncoding>UTF-8</OutputEncoding>
1256 <InputEncoding>UTF-8</InputEncoding>
1257 </OpenSearchDescription>
1261 return Apache2::Const::OK;
1264 sub opensearch_feed {
1266 return Apache2::Const::DECLINED if (-e $apache->filename);
1271 my $year = (gmtime())[5] + 1900;
1273 my $host = $cgi->virtual_host || $cgi->server_name;
1276 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1277 my $rel_name = $cgi->url(-relative=>1);
1278 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1281 my $url = $cgi->url(-path_info=>$add_path);
1282 my $root = (split 'opensearch', $url)[0];
1283 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1284 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1286 my $path = $cgi->path_info;
1287 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1289 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1295 if (!$lib || $lib eq '-') {
1296 $lib = $actor->request(
1297 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1298 )->gather(1)->[0]->shortname;
1301 if ($class eq '-') {
1305 return opensearch_osd($version, $lib, $class, $base, $host);
1309 my $page = $cgi->param('startPage') || 1;
1310 my $offset = $cgi->param('startIndex') || 1;
1311 my $limit = $cgi->param('count') || 10;
1313 $page = 1 if ($page !~ /^\d+$/);
1314 $offset = 1 if ($offset !~ /^\d+$/);
1315 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1318 $offset = ($page - 1) * $limit;
1323 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1324 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1326 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1327 $lang = '' if ($lang eq '*');
1329 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1331 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1334 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1335 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1337 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1340 $type = $cgi->param('responseType') if $cgi->param('responseType');
1343 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1347 my $kwt = $cgi->param('kw');
1348 my $tit = $cgi->param('ti');
1349 my $aut = $cgi->param('au');
1350 my $sut = $cgi->param('su');
1351 my $set = $cgi->param('se');
1353 $terms .= " " if ($terms && $kwt);
1354 $terms .= "keyword: $kwt" if ($kwt);
1355 $terms .= " " if ($terms && $tit);
1356 $terms .= "title: $tit" if ($tit);
1357 $terms .= " " if ($terms && $aut);
1358 $terms .= "author: $aut" if ($aut);
1359 $terms .= " " if ($terms && $sut);
1360 $terms .= "subject: $sut" if ($sut);
1361 $terms .= " " if ($terms && $set);
1362 $terms .= "series: $set" if ($set);
1364 if ($version eq '1.0') {
1366 } elsif ($type eq '-') {
1369 my $flesh_feed = parse_feed_type($type);
1371 $terms = decode_utf8($terms);
1372 $lang = 'eng' if ($lang eq 'en-US');
1374 $log->debug("OpenSearch terms: $terms");
1376 my $org_unit = get_ou($org);
1378 # Apostrophes break search and get indexed as spaces anyway
1379 my $safe_terms = $terms;
1380 $safe_terms =~ s{'}{ }go;
1382 my $recs = $search->request(
1383 'open-ils.search.biblio.multiclass.query' => {
1384 org_unit => $org_unit->[0]->id,
1388 sort_dir => $sortdir,
1389 default_class => $class,
1390 ($lang ? ( 'language' => $lang ) : ()),
1391 } => $safe_terms => 1
1394 $log->debug("Hits for [$terms]: $recs->{count}");
1396 my $feed = create_record_feed(
1399 [ map { $_->[0] } @{$recs->{ids}} ],
1406 $log->debug("Feed created...");
1410 $feed->search($safe_terms);
1411 $feed->class($class);
1413 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1415 $feed->creator($host);
1418 $feed->_create_node(
1419 $feed->{item_xpath},
1420 'http://a9.com/-/spec/opensearch/1.1/',
1425 $feed->_create_node(
1426 $feed->{item_xpath},
1427 'http://a9.com/-/spec/opensearch/1.1/',
1432 $feed->_create_node(
1433 $feed->{item_xpath},
1434 'http://a9.com/-/spec/opensearch/1.1/',
1439 $log->debug("...basic feed data added...");
1443 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1444 'application/opensearch+xml'
1445 ) if ($offset + $limit < $recs->{count});
1449 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1450 'application/opensearch+xml'
1455 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1456 'application/opensearch+xml'
1461 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1462 'application/rss+xml'
1467 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1468 'application/atom+xml'
1473 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1479 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1483 $feed->link( 'unapi-server' => $unapi);
1485 $log->debug("...feed links added...");
1489 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1490 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1494 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1496 -type => $feed->type, -charset => 'UTF-8',
1497 extra_headers_per_type_to_cgi($type)
1498 ), $feed->toString, "\n";
1500 $log->debug("...and feed returned.");
1502 return Apache2::Const::OK;
1505 sub create_record_feed {
1508 my $records = shift;
1511 my $lib = uc(shift()) || '-';
1518 my $base = $cgi->url;
1519 my $host = $cgi->virtual_host || $cgi->server_name;
1521 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1525 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1527 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1529 $type =~ s/(-full|-uris)$//o;
1531 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1532 $feed->base($base) if ($flesh);
1533 $feed->unapi($unapi) if ($flesh);
1535 $type = 'atom' if ($type eq 'html');
1536 $type = 'marcxml' if
1537 $type eq 'htmlholdings' or
1538 $type eq 'marctxt' or
1540 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1542 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1545 for my $record (@$records) {
1546 next unless($record);
1548 #my $rec = $record->id;
1551 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1552 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1553 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1554 $item_tag .= "/$depth" if (defined($depth));
1556 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1558 my $xml = $supercat->request(
1559 "open-ils.supercat.$search.$type.retrieve",
1564 my $node = $feed->add_item($xml);
1568 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1569 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1570 while ( !$r->complete ) {
1571 $xml .= join('', map {$_->content} $r->recv);
1573 $xml .= join('', map {$_->content} $r->recv);
1574 $node->add_holdings($xml);
1577 $node->id($item_tag);
1578 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1579 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1580 $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1581 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1582 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1583 $node->link('unapi-id' => $item_tag) if ($flesh);
1591 return Apache2::Const::DECLINED if (-e $apache->filename);
1596 my $year = (gmtime())[5] + 1900;
1598 my $host = $cgi->virtual_host || $cgi->server_name;
1601 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1602 my $rel_name = $cgi->url(-relative=>1);
1603 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1606 my $url = $cgi->url(-path_info=>$add_path);
1607 my $root = (split 'browse', $url)[0];
1608 my $base = (split 'browse', $url)[0] . 'browse';
1609 my $unapi = (split 'browse', $url)[0] . 'unapi';
1611 my $path = $cgi->path_info;
1614 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1615 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1617 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1619 my $status = [$cgi->param('status')];
1620 my $cpLoc = [$cgi->param('copyLocation')];
1621 $site ||= $cgi->param('searchOrg');
1622 $page ||= $cgi->param('startPage') || 0;
1623 $page_size ||= $cgi->param('count') || 9;
1624 $thesauruses //= '';
1625 $thesauruses =~ s/\s//g;
1626 # protect against cats bouncing on the comma key...
1627 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1629 $page = 0 if ($page !~ /^-?\d+$/);
1630 $page_size = 9 if $page_size !~ /^\d+$/;
1632 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1633 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1635 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1636 warn "something's wrong...";
1637 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1641 $string = decode_utf8($string);
1642 $string =~ s/\+/ /go;
1646 if ($axis =~ /^authority/) {
1647 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1649 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1650 $method .= ".refs" if $refs;
1652 $tree = $supercat->request(
1661 $tree = $supercat->request(
1662 "open-ils.supercat.$axis.browse",
1672 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1674 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1675 print $header.$content;
1676 return Apache2::Const::OK;
1679 sub string_startwith {
1681 return Apache2::Const::DECLINED if (-e $apache->filename);
1686 my $year = (gmtime())[5] + 1900;
1688 my $host = $cgi->virtual_host || $cgi->server_name;
1691 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1692 my $rel_name = $cgi->url(-relative=>1);
1693 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1696 my $url = $cgi->url(-path_info=>$add_path);
1697 my $root = (split 'startwith', $url)[0];
1698 my $base = (split 'startwith', $url)[0] . 'startwith';
1699 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1701 my $path = $cgi->path_info;
1704 my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1705 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1707 my $status = [$cgi->param('status')];
1708 my $cpLoc = [$cgi->param('copyLocation')];
1709 $site ||= $cgi->param('searchOrg');
1710 $page ||= $cgi->param('startPage') || 0;
1711 $page_size ||= $cgi->param('count') || 9;
1712 $thesauruses //= '';
1713 $thesauruses =~ s/\s//g;
1714 # protect against cats bouncing on the comma key...
1715 $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1717 $page = 0 if ($page !~ /^-?\d+$/);
1718 $page_size = 9 if $page_size !~ /^\d+$/;
1720 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1721 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1723 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1724 warn "something's wrong...";
1725 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1729 $string = decode_utf8($string);
1730 $string =~ s/\+/ /go;
1734 if ($axis =~ /^authority/) {
1735 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1737 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1738 $method .= ".refs" if $refs;
1740 $tree = $supercat->request(
1749 $tree = $supercat->request(
1750 "open-ils.supercat.$axis.startwith",
1760 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1762 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1763 print $header.$content;
1764 return Apache2::Const::OK;
1767 sub item_age_browse {
1769 return Apache2::Const::DECLINED if (-e $apache->filename);
1774 my $year = (gmtime())[5] + 1900;
1776 my $host = $cgi->virtual_host || $cgi->server_name;
1779 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1780 my $rel_name = $cgi->url(-relative=>1);
1781 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1784 my $url = $cgi->url(-path_info=>$add_path);
1785 my $root = (split 'browse', $url)[0];
1786 my $base = (split 'browse', $url)[0] . 'browse';
1787 my $unapi = (split 'browse', $url)[0] . 'unapi';
1789 my $path = $cgi->path_info;
1792 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1793 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1795 unless ($axis eq 'item-age') {
1796 warn "something's wrong...";
1797 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1801 my $status = [$cgi->param('status')];
1802 my $cpLoc = [$cgi->param('copyLocation')];
1803 $site ||= $cgi->param('searchOrg') || '-';
1804 $page ||= $cgi->param('startPage') || 1;
1805 $page_size ||= $cgi->param('count') || 10;
1807 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1808 $page_size = 10 if $page_size !~ /^\d+$/;
1810 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1811 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1813 my $recs = $supercat->request(
1814 "open-ils.supercat.new_book_list",
1822 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1824 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1825 print $header.$content;
1826 return Apache2::Const::OK;
1829 our %qualifier_ids = (
1830 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1831 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1832 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1836 # Our authority search options are currently pretty impoverished;
1837 # just right-truncated string match on a few categories, or by
1839 our %nested_auth_qualifier_map = (
1841 id => { index => 'id', title => 'Record number'},
1842 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1843 title => { index => 'title', title => 'Uniform title'},
1844 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1845 topic => { index => 'topic', title => 'Topical term'},
1849 my $base_explain = <<XML;
1851 id="evergreen-sru-explain-full"
1852 authoritative="true"
1853 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1854 xmlns="http://explain.z3950.org/dtd/2.0/">
1855 <serverInfo transport="http" protocol="SRU" version="1.1">
1862 <title primary="true"/>
1863 <description primary="true"/>
1867 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1872 identifier="info:srw/schema/1/marcxml-v1.1"
1873 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1877 <title>MARC21Slim (marcxml)</title>
1882 <default type="numberOfRecords">10</default>
1883 <default type="contextSet">eg</default>
1884 <default type="index">keyword</default>
1885 <default type="relation">all</default>
1886 <default type="sortSchema">marcxml</default>
1887 <default type="retrieveSchema">marcxml</default>
1888 <setting type="maximumRecords">50</setting>
1889 <supports type="relationModifier">relevant</supports>
1890 <supports type="relationModifier">stem</supports>
1891 <supports type="relationModifier">fuzzy</supports>
1892 <supports type="relationModifier">word</supports>
1905 my $req = SRU::Request->newFromCGI( $cgi );
1906 my $resp = SRU::Response->newFromRequest( $req );
1908 # Find the org_unit shortname, if passed as part of the URL
1909 # http://example.com/opac/extras/sru/SHORTNAME
1910 my $url = $cgi->path_info;
1911 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1913 if ( $resp->type eq 'searchRetrieve' ) {
1915 # Older versions of Debian packages returned terms to us double-encoded,
1916 # so we had to forcefully double-decode them a second time with
1917 # an outer decode('utf8', $string) call; this seems to be resolved with
1918 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1919 my $cql_query = decode_utf8($req->query);
1920 my $search_string = decode_utf8($req->cql->toEvergreen);
1922 # Ensure the search string overrides the default site
1923 if ($shortname and $search_string !~ m#site:#) {
1924 $search_string .= " site:$shortname";
1927 my $offset = $req->startRecord;
1928 $offset-- if ($offset);
1931 my $limit = $req->maximumRecords;
1934 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1936 my $recs = $search->request(
1937 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1940 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1942 foreach my $record (@$bre) {
1943 my $marcxml = $record->marc;
1944 # Make the beast conform to a VDX-supported format
1945 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1946 # Trying to implement LIBSOL_852_A format; so much for standards
1948 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1949 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1951 # Force record leader to 'a' as our data is always UTF8
1952 # Avoids marc8_to_utf8 from being invoked with horrible results
1953 # on the off-chance the record leader isn't correct
1954 my $ldr = $marc->leader;
1955 substr($ldr, 9, 1, 'a');
1956 $marc->leader($ldr);
1958 # Expects the record ID in the 001
1959 $marc->delete_field($_) for ($marc->field('001'));
1960 if (!$marc->field('001')) {
1961 $marc->insert_fields_ordered(
1962 MARC::Field->new( '001', $record->id )
1965 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1966 foreach my $cn (keys %$bib_holdings) {
1967 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1968 $marc->insert_fields_ordered(
1971 a => $cp->{'location'},
1972 b => $bib_holdings->{$cn}->{'owning_lib'},
1974 d => $cp->{'circlib'},
1975 g => $cp->{'barcode'},
1976 n => $cp->{'status'},
1982 $marcxml = $marc->as_xml_record();
1983 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1987 SRU::Response::Record->new(
1988 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1989 recordData => $marcxml,
1990 recordPosition => ++$offset
1995 $resp->numberOfRecords($recs->{count});
1997 } elsif ( $resp->type eq 'explain' ) {
1998 return_sru_explain($cgi, $req, $resp, \$ex_doc,
2000 \%OpenILS::WWW::SuperCat::qualifier_ids
2004 SRU::Response::Record->new(
2005 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2006 recordData => $ex_doc
2011 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2012 print $U->entityize($resp->asXML) . "\n";
2013 return Apache2::Const::OK;
2018 package CQL::BooleanNode;
2022 my $left = $self->left();
2023 my $right = $self->right();
2024 my $leftStr = $left->toEvergreen;
2025 my $rightStr = $right->toEvergreen();
2027 my $op = '||' if uc $self->op() eq 'OR';
2030 return "$leftStr $rightStr";
2033 sub toEvergreenAuth {
2034 return toEvergreen(shift);
2037 package CQL::TermNode;
2041 my $qualifier = $self->getQualifier();
2042 my $term = $self->getTerm();
2043 my $relation = $self->getRelation();
2047 my ($qset, $qname) = split(/\./, $qualifier);
2049 # Per http://www.loc.gov/standards/sru/specs/cql.html
2050 # "All parts of CQL are case insensitive [...] If any case insensitive
2051 # part of CQL is specified with both upper and lower case, it is for
2052 # aesthetic purposes only."
2054 # So fold the qualifier and relation to lower case
2056 $qname = lc($qname);
2058 if ( exists($qualifier_map{$qset}{$qname}) ) {
2059 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2060 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2063 my @modifiers = $relation->getModifiers();
2065 my $base = $relation->getBase();
2066 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2069 foreach my $m ( @modifiers ) {
2070 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2076 $quote_it = 0 if ( $base eq 'all' );
2077 $term = maybeQuote($term) if $quote_it;
2080 croak( "Evergreen doesn't support the $base relations" );
2088 return "$qualifier:$term";
2091 sub toEvergreenAuth {
2093 my $qualifier = $self->getQualifier();
2094 my $term = $self->getTerm();
2095 my $relation = $self->getRelation();
2099 my ($qset, $qname) = split(/\./, $qualifier);
2101 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2102 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2103 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2106 return { qualifier => $qualifier, term => $term };
2111 sub sru_auth_search {
2116 my $req = SRU::Request->newFromCGI( $cgi );
2117 my $resp = SRU::Response->newFromRequest( $req );
2119 if ( $resp->type eq 'searchRetrieve' ) {
2120 return_auth_response($cgi, $req, $resp);
2121 } elsif ( $resp->type eq 'explain' ) {
2122 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2123 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2124 \%OpenILS::WWW::SuperCat::qualifier_ids
2128 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2129 print $U->entityize($resp->asXML) . "\n";
2130 return Apache2::Const::OK;
2133 sub explain_header {
2136 my $host = $cgi->virtual_host || $cgi->server_name;
2139 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2140 my $rel_name = $cgi->url(-relative=>1);
2141 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2143 my $base = $cgi->url(-base=>1);
2144 my $url = $cgi->url(-path_info=>$add_path);
2145 $url =~ s/^$base\///o;
2147 my $doc = $parser->parse_string($base_explain);
2148 my $e = $doc->documentElement;
2149 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2150 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2151 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2156 sub return_sru_explain {
2157 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2159 $index_map ||= \%qualifier_map;
2161 my ($doc, $e) = explain_header($cgi);
2162 for my $name ( keys %{$index_map} ) {
2164 my $identifier = $qualifier_ids->{ $name };
2166 next unless $identifier;
2168 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2169 $set_node->setAttribute( identifier => $identifier );
2170 $set_node->setAttribute( name => $name );
2172 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2173 for my $index ( sort keys %{$index_map->{$name}} ) {
2174 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2176 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2177 $map_node->appendChild( $name_node );
2179 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2181 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2182 $index_node->appendChild( $title_node );
2183 $index_node->appendChild( $map_node );
2185 $index_node->setAttribute( id => "$name.$index" );
2186 $title_node->appendText($index_map->{$name}{$index}{'title'});
2187 $name_node->setAttribute( set => $name );
2188 $name_node->appendText($index_map->{$name}{$index}{'index'});
2190 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2194 $$explain = $e->toString;
2198 SRU::Response::Record->new(
2199 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2200 recordData => $$explain
2206 sub return_auth_response {
2207 my ($cgi, $req, $resp) = @_;
2209 my $cql_query = decode_utf8($req->query);
2210 my $search = $req->cql->toEvergreenAuth;
2212 my $qualifier = decode_utf8($search->{qualifier});
2213 my $term = decode_utf8($search->{term});
2215 $log->info("SRU NAF search string [$cql_query] converted to "
2216 . "[$qualifier:$term]\n");
2218 my $page_size = $req->maximumRecords;
2221 # startwith deals with pages, so convert startRecord to a page number
2222 my $page = ($req->startRecord / $page_size) || 0;
2225 if ($qualifier eq "id") {
2226 $recs = [ int($term) ];
2228 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2230 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2231 $method .= ".refs" if $refs;
2233 $recs = $supercat->request(
2242 my $record_position = $req->startRecord;
2243 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2244 foreach my $record (@$recs) {
2245 my $marcxml = $cstore->request(
2246 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2250 SRU::Response::Record->new(
2251 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2252 recordData => $marcxml,
2253 recordPosition => ++$record_position
2258 $resp->numberOfRecords(scalar(@$recs));
2261 =head2 get_ou($org_unit)
2263 Returns an aou object for a given actor.org_unit shortname or ID.
2268 my $org = shift || '-';
2272 $org_unit = $actor->request(
2273 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2275 } elsif ($org !~ /^\d+$/o) {
2276 $org_unit = $actor->request(
2277 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2280 $org_unit = $actor->request(
2281 'open-ils.actor.org_unit_list.search' => id => $org