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) = split '/', $path;
1615 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
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;
1625 $page = 0 if ($page !~ /^-?\d+$/);
1626 $page_size = 9 if $page_size !~ /^\d+$/;
1628 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1629 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1631 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1632 warn "something's wrong...";
1633 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1637 $string = decode_utf8($string);
1638 $string =~ s/\+/ /go;
1642 if ($axis =~ /^authority/) {
1643 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1645 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1646 $method .= ".refs" if $refs;
1648 $tree = $supercat->request(
1656 $tree = $supercat->request(
1657 "open-ils.supercat.$axis.browse",
1667 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1669 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1670 print $header.$content;
1671 return Apache2::Const::OK;
1674 sub string_startwith {
1676 return Apache2::Const::DECLINED if (-e $apache->filename);
1681 my $year = (gmtime())[5] + 1900;
1683 my $host = $cgi->virtual_host || $cgi->server_name;
1686 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1687 my $rel_name = $cgi->url(-relative=>1);
1688 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1691 my $url = $cgi->url(-path_info=>$add_path);
1692 my $root = (split 'startwith', $url)[0];
1693 my $base = (split 'startwith', $url)[0] . 'startwith';
1694 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1696 my $path = $cgi->path_info;
1699 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1700 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1702 my $status = [$cgi->param('status')];
1703 my $cpLoc = [$cgi->param('copyLocation')];
1704 $site ||= $cgi->param('searchOrg');
1705 $page ||= $cgi->param('startPage') || 0;
1706 $page_size ||= $cgi->param('count') || 9;
1708 $page = 0 if ($page !~ /^-?\d+$/);
1709 $page_size = 9 if $page_size !~ /^\d+$/;
1711 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1712 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1714 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1715 warn "something's wrong...";
1716 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1720 $string = decode_utf8($string);
1721 $string =~ s/\+/ /go;
1725 if ($axis =~ /^authority/) {
1726 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1728 my $method = "open-ils.supercat.authority.browse_top.by_axis";
1729 $method .= ".refs" if $refs;
1731 $tree = $supercat->request(
1739 $tree = $supercat->request(
1740 "open-ils.supercat.$axis.startwith",
1750 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1752 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1753 print $header.$content;
1754 return Apache2::Const::OK;
1757 sub item_age_browse {
1759 return Apache2::Const::DECLINED if (-e $apache->filename);
1764 my $year = (gmtime())[5] + 1900;
1766 my $host = $cgi->virtual_host || $cgi->server_name;
1769 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1770 my $rel_name = $cgi->url(-relative=>1);
1771 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1774 my $url = $cgi->url(-path_info=>$add_path);
1775 my $root = (split 'browse', $url)[0];
1776 my $base = (split 'browse', $url)[0] . 'browse';
1777 my $unapi = (split 'browse', $url)[0] . 'unapi';
1779 my $path = $cgi->path_info;
1782 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1783 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1785 unless ($axis eq 'item-age') {
1786 warn "something's wrong...";
1787 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1791 my $status = [$cgi->param('status')];
1792 my $cpLoc = [$cgi->param('copyLocation')];
1793 $site ||= $cgi->param('searchOrg') || '-';
1794 $page ||= $cgi->param('startPage') || 1;
1795 $page_size ||= $cgi->param('count') || 10;
1797 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1798 $page_size = 10 if $page_size !~ /^\d+$/;
1800 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1801 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1803 my $recs = $supercat->request(
1804 "open-ils.supercat.new_book_list",
1812 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1814 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1815 print $header.$content;
1816 return Apache2::Const::OK;
1819 our %qualifier_ids = (
1820 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1821 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1822 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1826 # Our authority search options are currently pretty impoverished;
1827 # just right-truncated string match on a few categories, or by
1829 our %nested_auth_qualifier_map = (
1831 id => { index => 'id', title => 'Record number'},
1832 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1833 title => { index => 'title', title => 'Uniform title'},
1834 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1835 topic => { index => 'topic', title => 'Topical term'},
1839 my $base_explain = <<XML;
1841 id="evergreen-sru-explain-full"
1842 authoritative="true"
1843 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1844 xmlns="http://explain.z3950.org/dtd/2.0/">
1845 <serverInfo transport="http" protocol="SRU" version="1.1">
1852 <title primary="true"/>
1853 <description primary="true"/>
1857 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1862 identifier="info:srw/schema/1/marcxml-v1.1"
1863 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1867 <title>MARC21Slim (marcxml)</title>
1872 <default type="numberOfRecords">10</default>
1873 <default type="contextSet">eg</default>
1874 <default type="index">keyword</default>
1875 <default type="relation">all</default>
1876 <default type="sortSchema">marcxml</default>
1877 <default type="retrieveSchema">marcxml</default>
1878 <setting type="maximumRecords">50</setting>
1879 <supports type="relationModifier">relevant</supports>
1880 <supports type="relationModifier">stem</supports>
1881 <supports type="relationModifier">fuzzy</supports>
1882 <supports type="relationModifier">word</supports>
1895 my $req = SRU::Request->newFromCGI( $cgi );
1896 my $resp = SRU::Response->newFromRequest( $req );
1898 # Find the org_unit shortname, if passed as part of the URL
1899 # http://example.com/opac/extras/sru/SHORTNAME
1900 my $url = $cgi->path_info;
1901 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1903 if ( $resp->type eq 'searchRetrieve' ) {
1905 # Older versions of Debian packages returned terms to us double-encoded,
1906 # so we had to forcefully double-decode them a second time with
1907 # an outer decode('utf8', $string) call; this seems to be resolved with
1908 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1909 my $cql_query = decode_utf8($req->query);
1910 my $search_string = decode_utf8($req->cql->toEvergreen);
1912 # Ensure the search string overrides the default site
1913 if ($shortname and $search_string !~ m#site:#) {
1914 $search_string .= " site:$shortname";
1917 my $offset = $req->startRecord;
1918 $offset-- if ($offset);
1921 my $limit = $req->maximumRecords;
1924 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1926 my $recs = $search->request(
1927 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1930 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1932 foreach my $record (@$bre) {
1933 my $marcxml = $record->marc;
1934 # Make the beast conform to a VDX-supported format
1935 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1936 # Trying to implement LIBSOL_852_A format; so much for standards
1938 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1939 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1941 # Force record leader to 'a' as our data is always UTF8
1942 # Avoids marc8_to_utf8 from being invoked with horrible results
1943 # on the off-chance the record leader isn't correct
1944 my $ldr = $marc->leader;
1945 substr($ldr, 9, 1, 'a');
1946 $marc->leader($ldr);
1948 # Expects the record ID in the 001
1949 $marc->delete_field($_) for ($marc->field('001'));
1950 if (!$marc->field('001')) {
1951 $marc->insert_fields_ordered(
1952 MARC::Field->new( '001', $record->id )
1955 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1956 foreach my $cn (keys %$bib_holdings) {
1957 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1958 $marc->insert_fields_ordered(
1961 a => $cp->{'location'},
1962 b => $bib_holdings->{$cn}->{'owning_lib'},
1964 d => $cp->{'circlib'},
1965 g => $cp->{'barcode'},
1966 n => $cp->{'status'},
1972 $marcxml = $marc->as_xml_record();
1973 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1977 SRU::Response::Record->new(
1978 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
1979 recordData => $marcxml,
1980 recordPosition => ++$offset
1985 $resp->numberOfRecords($recs->{count});
1987 } elsif ( $resp->type eq 'explain' ) {
1988 return_sru_explain($cgi, $req, $resp, \$ex_doc,
1990 \%OpenILS::WWW::SuperCat::qualifier_ids
1994 SRU::Response::Record->new(
1995 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
1996 recordData => $ex_doc
2001 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2002 print $U->entityize($resp->asXML) . "\n";
2003 return Apache2::Const::OK;
2008 package CQL::BooleanNode;
2012 my $left = $self->left();
2013 my $right = $self->right();
2014 my $leftStr = $left->toEvergreen;
2015 my $rightStr = $right->toEvergreen();
2017 my $op = '||' if uc $self->op() eq 'OR';
2020 return "$leftStr $rightStr";
2023 sub toEvergreenAuth {
2024 return toEvergreen(shift);
2027 package CQL::TermNode;
2031 my $qualifier = $self->getQualifier();
2032 my $term = $self->getTerm();
2033 my $relation = $self->getRelation();
2037 my ($qset, $qname) = split(/\./, $qualifier);
2039 # Per http://www.loc.gov/standards/sru/specs/cql.html
2040 # "All parts of CQL are case insensitive [...] If any case insensitive
2041 # part of CQL is specified with both upper and lower case, it is for
2042 # aesthetic purposes only."
2044 # So fold the qualifier and relation to lower case
2046 $qname = lc($qname);
2048 if ( exists($qualifier_map{$qset}{$qname}) ) {
2049 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2050 $log->debug("SRU toEvergreen: $qset, $qname $qualifier_map{$qset}{$qname}{'index'}\n");
2053 my @modifiers = $relation->getModifiers();
2055 my $base = $relation->getBase();
2056 if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2059 foreach my $m ( @modifiers ) {
2060 if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2066 $quote_it = 0 if ( $base eq 'all' );
2067 $term = maybeQuote($term) if $quote_it;
2070 croak( "Evergreen doesn't support the $base relations" );
2078 return "$qualifier:$term";
2081 sub toEvergreenAuth {
2083 my $qualifier = $self->getQualifier();
2084 my $term = $self->getTerm();
2085 my $relation = $self->getRelation();
2089 my ($qset, $qname) = split(/\./, $qualifier);
2091 if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2092 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2093 $log->debug("SRU toEvergreenAuth: $qset, $qname $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2096 return { qualifier => $qualifier, term => $term };
2101 sub sru_auth_search {
2106 my $req = SRU::Request->newFromCGI( $cgi );
2107 my $resp = SRU::Response->newFromRequest( $req );
2109 if ( $resp->type eq 'searchRetrieve' ) {
2110 return_auth_response($cgi, $req, $resp);
2111 } elsif ( $resp->type eq 'explain' ) {
2112 return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2113 \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2114 \%OpenILS::WWW::SuperCat::qualifier_ids
2118 print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2119 print $U->entityize($resp->asXML) . "\n";
2120 return Apache2::Const::OK;
2123 sub explain_header {
2126 my $host = $cgi->virtual_host || $cgi->server_name;
2129 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2130 my $rel_name = $cgi->url(-relative=>1);
2131 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2133 my $base = $cgi->url(-base=>1);
2134 my $url = $cgi->url(-path_info=>$add_path);
2135 $url =~ s/^$base\///o;
2137 my $doc = $parser->parse_string($base_explain);
2138 my $e = $doc->documentElement;
2139 $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2140 $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2141 $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2146 sub return_sru_explain {
2147 my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2149 $index_map ||= \%qualifier_map;
2151 my ($doc, $e) = explain_header($cgi);
2152 for my $name ( keys %{$index_map} ) {
2154 my $identifier = $qualifier_ids->{ $name };
2156 next unless $identifier;
2158 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2159 $set_node->setAttribute( identifier => $identifier );
2160 $set_node->setAttribute( name => $name );
2162 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2163 for my $index ( sort keys %{$index_map->{$name}} ) {
2164 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2166 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2167 $map_node->appendChild( $name_node );
2169 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2171 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2172 $index_node->appendChild( $title_node );
2173 $index_node->appendChild( $map_node );
2175 $index_node->setAttribute( id => "$name.$index" );
2176 $title_node->appendText($index_map->{$name}{$index}{'title'});
2177 $name_node->setAttribute( set => $name );
2178 $name_node->appendText($index_map->{$name}{$index}{'index'});
2180 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2184 $$explain = $e->toString;
2188 SRU::Response::Record->new(
2189 recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1',
2190 recordData => $$explain
2196 sub return_auth_response {
2197 my ($cgi, $req, $resp) = @_;
2199 my $cql_query = decode_utf8($req->query);
2200 my $search = $req->cql->toEvergreenAuth;
2202 my $qualifier = decode_utf8($search->{qualifier});
2203 my $term = decode_utf8($search->{term});
2205 $log->info("SRU NAF search string [$cql_query] converted to "
2206 . "[$qualifier:$term]\n");
2208 my $page_size = $req->maximumRecords;
2211 # startwith deals with pages, so convert startRecord to a page number
2212 my $page = ($req->startRecord / $page_size) || 0;
2215 if ($qualifier eq "id") {
2216 $recs = [ int($term) ];
2218 my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2220 my $method = "open-ils.supercat.authority.browse_top.by_axis";
2221 $method .= ".refs" if $refs;
2223 $recs = $supercat->request(
2232 my $record_position = $req->startRecord;
2233 my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2234 foreach my $record (@$recs) {
2235 my $marcxml = $cstore->request(
2236 'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2240 SRU::Response::Record->new(
2241 recordSchema => 'info:srw/schema/1/marcxml-v1.1',
2242 recordData => $marcxml,
2243 recordPosition => ++$record_position
2248 $resp->numberOfRecords(scalar(@$recs));
2251 =head2 get_ou($org_unit)
2253 Returns an aou object for a given actor.org_unit shortname or ID.
2258 my $org = shift || '-';
2262 $org_unit = $actor->request(
2263 'open-ils.actor.org_unit_list.search' => parent_ou => undef
2265 } elsif ($org !~ /^\d+$/o) {
2266 $org_unit = $actor->request(
2267 'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2270 $org_unit = $actor->request(
2271 'open-ils.actor.org_unit_list.search' => id => $org