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: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$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: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$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 ($type eq 'opac') {
1075 print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1076 join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
1081 # last created first
1082 my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1084 my $feed = create_record_feed(
1087 [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1089 $org_unit->[0]->shortname,
1094 $feed->id($bucket_tag);
1096 $feed->title("Items in Book Bag [".$bucket->name."]");
1097 $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1098 $feed->creator($host);
1101 $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1102 $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1103 $feed->link(html => $base . "/html-full/$id" => 'text/html');
1104 $feed->link(unapi => $unapi);
1108 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1109 join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
1114 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1115 print $feed->toString . "\n";
1117 return Apache2::Const::OK;
1122 return Apache2::Const::DECLINED if (-e $apache->filename);
1128 my $year = (gmtime())[5] + 1900;
1129 my $host = $cgi->virtual_host || $cgi->server_name;
1132 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1133 my $rel_name = $cgi->url(-relative=>1);
1134 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1137 my $url = $cgi->url(-path_info=>$add_path);
1138 my $root = (split 'feed', $url)[0];
1139 my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1140 my $unapi = (split 'feed', $url)[0] . 'unapi';
1142 my $skin = $cgi->param('skin') || 'default';
1143 my $locale = $cgi->param('locale') || 'en-US';
1144 my $org = $cgi->param('searchOrg');
1146 # Enable localized results of copy status, etc
1147 $supercat->session_locale($locale);
1149 my $org_unit = get_ou($org);
1150 my $scope = "l=" . $org_unit->[0]->id . "&";
1152 my $path = $cgi->path_info;
1153 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1155 $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1157 my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1158 my $flesh_feed = parse_feed_type($type);
1161 $limit = 10 if $limit !~ /^\d+$/;
1163 my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1165 #if ($type eq 'opac') {
1166 # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1167 # join('&', map { "rl=" . $_ } @$list) .
1172 my $search = 'record';
1173 if ($rtype eq 'authority') {
1174 $search = 'authority';
1176 my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1180 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1182 $feed->title("$limit most recent $rtype ${axis}s");
1185 $feed->creator($host);
1188 $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1189 $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1190 $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1191 $feed->link(unapi => $unapi);
1195 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1196 join('&', map { 'rl=' . $_} @$list ),
1201 print "Content-type: ". $feed->type ."; charset=utf-8\n";
1203 print $_ for extra_headers_per_type_to_string($type);
1205 print "\n", $feed->toString, "\n";
1207 return Apache2::Const::OK;
1210 sub opensearch_osd {
1211 my $version = shift;
1216 if ($version eq '1.0') {
1218 Content-type: application/opensearchdescription+xml; charset=utf-8
1220 <?xml version="1.0" encoding="UTF-8"?>
1221 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1222 <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}</Url>
1223 <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1224 <ShortName>$lib</ShortName>
1225 <LongName>Search $lib</LongName>
1226 <Description>Search the $lib OPAC by $class.</Description>
1227 <Tags>$lib book library</Tags>
1228 <SampleSearch>harry+potter</SampleSearch>
1229 <Developer>Mike Rylander for GPLS/PINES</Developer>
1230 <Contact>feedback\@open-ils.org</Contact>
1231 <SyndicationRight>open</SyndicationRight>
1232 <AdultContent>false</AdultContent>
1233 </OpenSearchDescription>
1237 Content-type: application/opensearchdescription+xml; charset=utf-8
1239 <?xml version="1.0" encoding="UTF-8"?>
1240 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1241 <ShortName>$lib</ShortName>
1242 <Description>Search the $lib OPAC by $class.</Description>
1243 <Tags>$lib book library</Tags>
1244 <Url type="application/rss+xml"
1245 template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1246 <Url type="application/atom+xml"
1247 template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1248 <Url type="application/x-mods3+xml"
1249 template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1250 <Url type="application/x-mods+xml"
1251 template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1252 <Url type="application/octet-stream"
1253 template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1254 <Url type="application/x-marcxml+xml"
1255 template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1256 <Url type="text/html"
1257 template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&startPage={startPage?}&startIndex={startIndex?}&count={count?}&searchLang={language?}"/>
1258 <LongName>Search $lib</LongName>
1259 <Query role="example" searchTerms="harry+potter" />
1260 <Developer>Mike Rylander for GPLS/PINES</Developer>
1261 <Contact>feedback\@open-ils.org</Contact>
1262 <SyndicationRight>open</SyndicationRight>
1263 <AdultContent>false</AdultContent>
1264 <Language>en-US</Language>
1265 <OutputEncoding>UTF-8</OutputEncoding>
1266 <InputEncoding>UTF-8</InputEncoding>
1267 </OpenSearchDescription>
1271 return Apache2::Const::OK;
1274 sub opensearch_feed {
1276 return Apache2::Const::DECLINED if (-e $apache->filename);
1281 my $year = (gmtime())[5] + 1900;
1283 my $host = $cgi->virtual_host || $cgi->server_name;
1286 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1287 my $rel_name = $cgi->url(-relative=>1);
1288 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1291 my $url = $cgi->url(-path_info=>$add_path);
1292 my $root = (split 'opensearch', $url)[0];
1293 my $base = (split 'opensearch', $url)[0] . 'opensearch';
1294 my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1296 my $path = $cgi->path_info;
1297 #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1299 if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1305 if (!$lib || $lib eq '-') {
1306 $lib = $actor->request(
1307 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1308 )->gather(1)->[0]->shortname;
1311 if ($class eq '-') {
1315 return opensearch_osd($version, $lib, $class, $base);
1319 my $page = $cgi->param('startPage') || 1;
1320 my $offset = $cgi->param('startIndex') || 1;
1321 my $limit = $cgi->param('count') || 10;
1323 $page = 1 if ($page !~ /^\d+$/);
1324 $offset = 1 if ($offset !~ /^\d+$/);
1325 $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1328 $offset = ($page - 1) * $limit;
1333 my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1334 (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1336 $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1337 $lang = '' if ($lang eq '*');
1339 $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1341 $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1344 $terms .= " " if ($terms && $cgi->param('searchTerms'));
1345 $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1347 $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1350 $type = $cgi->param('responseType') if $cgi->param('responseType');
1353 $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1357 my $kwt = $cgi->param('kw');
1358 my $tit = $cgi->param('ti');
1359 my $aut = $cgi->param('au');
1360 my $sut = $cgi->param('su');
1361 my $set = $cgi->param('se');
1363 $terms .= " " if ($terms && $kwt);
1364 $terms .= "keyword: $kwt" if ($kwt);
1365 $terms .= " " if ($terms && $tit);
1366 $terms .= "title: $tit" if ($tit);
1367 $terms .= " " if ($terms && $aut);
1368 $terms .= "author: $aut" if ($aut);
1369 $terms .= " " if ($terms && $sut);
1370 $terms .= "subject: $sut" if ($sut);
1371 $terms .= " " if ($terms && $set);
1372 $terms .= "series: $set" if ($set);
1374 if ($version eq '1.0') {
1376 } elsif ($type eq '-') {
1379 my $flesh_feed = parse_feed_type($type);
1381 $terms = decode_utf8($terms);
1382 $lang = 'eng' if ($lang eq 'en-US');
1384 $log->debug("OpenSearch terms: $terms");
1386 my $org_unit = get_ou($org);
1388 # Apostrophes break search and get indexed as spaces anyway
1389 my $safe_terms = $terms;
1390 $safe_terms =~ s{'}{ }go;
1392 my $recs = $search->request(
1393 'open-ils.search.biblio.multiclass.query' => {
1394 org_unit => $org_unit->[0]->id,
1398 sort_dir => $sortdir,
1399 default_class => $class,
1400 ($lang ? ( 'language' => $lang ) : ()),
1401 } => $safe_terms => 1
1404 $log->debug("Hits for [$terms]: $recs->{count}");
1406 my $feed = create_record_feed(
1409 [ map { $_->[0] } @{$recs->{ids}} ],
1416 $log->debug("Feed created...");
1420 $feed->search($safe_terms);
1421 $feed->class($class);
1423 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1425 $feed->creator($host);
1428 $feed->_create_node(
1429 $feed->{item_xpath},
1430 'http://a9.com/-/spec/opensearch/1.1/',
1435 $feed->_create_node(
1436 $feed->{item_xpath},
1437 'http://a9.com/-/spec/opensearch/1.1/',
1442 $feed->_create_node(
1443 $feed->{item_xpath},
1444 'http://a9.com/-/spec/opensearch/1.1/',
1449 $log->debug("...basic feed data added...");
1453 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1454 'application/opensearch+xml'
1455 ) if ($offset + $limit < $recs->{count});
1459 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1460 'application/opensearch+xml'
1465 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1466 'application/opensearch+xml'
1471 $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1472 'application/rss+xml'
1477 $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1478 'application/atom+xml'
1483 $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1489 $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1493 $feed->link( 'unapi-server' => $unapi);
1495 $log->debug("...feed links added...");
1499 # $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1500 # join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1504 #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1506 -type => $feed->type, -charset => 'UTF-8',
1507 extra_headers_per_type_to_cgi($type)
1508 ), $feed->toString, "\n";
1510 $log->debug("...and feed returned.");
1512 return Apache2::Const::OK;
1515 sub create_record_feed {
1518 my $records = shift;
1521 my $lib = uc(shift()) || '-';
1528 my $base = $cgi->url;
1529 my $host = $cgi->virtual_host || $cgi->server_name;
1531 my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1535 my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1537 my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1539 $type =~ s/(-full|-uris)$//o;
1541 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1542 $feed->base($base) if ($flesh);
1543 $feed->unapi($unapi) if ($flesh);
1545 $type = 'atom' if ($type eq 'html');
1546 $type = 'marcxml' if
1547 $type eq 'htmlholdings' or
1548 $type eq 'marctxt' or
1550 $type eq 'marc21'; # kludgy since it isn't an XML format, but needed
1552 #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1555 for my $record (@$records) {
1556 next unless($record);
1558 #my $rec = $record->id;
1561 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1562 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1563 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1564 $item_tag .= "/$depth" if (defined($depth));
1566 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1568 my $xml = $supercat->request(
1569 "open-ils.supercat.$search.$type.retrieve",
1574 my $node = $feed->add_item($xml);
1578 if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1579 my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1580 while ( !$r->complete ) {
1581 $xml .= join('', map {$_->content} $r->recv);
1583 $xml .= join('', map {$_->content} $r->recv);
1584 $node->add_holdings($xml);
1587 $node->id($item_tag);
1588 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1589 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1590 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1591 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1592 $node->link('unapi-id' => $item_tag) if ($flesh);
1600 return Apache2::Const::DECLINED if (-e $apache->filename);
1605 my $year = (gmtime())[5] + 1900;
1607 my $host = $cgi->virtual_host || $cgi->server_name;
1610 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1611 my $rel_name = $cgi->url(-relative=>1);
1612 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1615 my $url = $cgi->url(-path_info=>$add_path);
1616 my $root = (split 'browse', $url)[0];
1617 my $base = (split 'browse', $url)[0] . 'browse';
1618 my $unapi = (split 'browse', $url)[0] . 'unapi';
1620 my $path = $cgi->path_info;
1623 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1624 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1626 return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1628 my $status = [$cgi->param('status')];
1629 my $cpLoc = [$cgi->param('copyLocation')];
1630 $site ||= $cgi->param('searchOrg');
1631 $page ||= $cgi->param('startPage') || 0;
1632 $page_size ||= $cgi->param('count') || 9;
1634 $page = 0 if ($page !~ /^-?\d+$/);
1635 $page_size = 9 if $page_size !~ /^\d+$/;
1637 my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1638 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1640 unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1641 warn "something's wrong...";
1642 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1646 $string = decode_utf8($string);
1647 $string =~ s/\+/ /go;
1651 if ($axis =~ /^authority/) {
1652 my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1654 my $method = "open-ils.supercat.authority.browse_center.by_axis";
1655 $method .= ".refs" if $refs;
1657 $tree = $supercat->request(
1665 $tree = $supercat->request(
1666 "open-ils.supercat.$axis.browse",
1676 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1678 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1679 print $header.$content;
1680 return Apache2::Const::OK;
1683 sub string_startwith {
1685 return Apache2::Const::DECLINED if (-e $apache->filename);
1690 my $year = (gmtime())[5] + 1900;
1692 my $host = $cgi->virtual_host || $cgi->server_name;
1695 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1696 my $rel_name = $cgi->url(-relative=>1);
1697 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1700 my $url = $cgi->url(-path_info=>$add_path);
1701 my $root = (split 'startwith', $url)[0];
1702 my $base = (split 'startwith', $url)[0] . 'startwith';
1703 my $unapi = (split 'startwith', $url)[0] . 'unapi';
1705 my $path = $cgi->path_info;
1708 my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1709 #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1711 my $status = [$cgi->param('status')];
1712 my $cpLoc = [$cgi->param('copyLocation')];
1713 $site ||= $cgi->param('searchOrg');
1714 $page ||= $cgi->param('startPage') || 0;
1715 $page_size ||= $cgi->param('count') || 9;
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);
1721 my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
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(
1748 $tree = $supercat->request(
1749 "open-ils.supercat.$axis.startwith",
1759 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1761 my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1762 print $header.$content;
1763 return Apache2::Const::OK;
1766 sub item_age_browse {
1768 return Apache2::Const::DECLINED if (-e $apache->filename);
1773 my $year = (gmtime())[5] + 1900;
1775 my $host = $cgi->virtual_host || $cgi->server_name;
1778 if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1779 my $rel_name = $cgi->url(-relative=>1);
1780 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1783 my $url = $cgi->url(-path_info=>$add_path);
1784 my $root = (split 'browse', $url)[0];
1785 my $base = (split 'browse', $url)[0] . 'browse';
1786 my $unapi = (split 'browse', $url)[0] . 'unapi';
1788 my $path = $cgi->path_info;
1791 my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1792 #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1794 unless ($axis eq 'item-age') {
1795 warn "something's wrong...";
1796 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1800 my $status = [$cgi->param('status')];
1801 my $cpLoc = [$cgi->param('copyLocation')];
1802 $site ||= $cgi->param('searchOrg') || '-';
1803 $page ||= $cgi->param('startPage') || 1;
1804 $page_size ||= $cgi->param('count') || 10;
1806 $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1807 $page_size = 10 if $page_size !~ /^\d+$/;
1809 my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1810 my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1812 my $recs = $supercat->request(
1813 "open-ils.supercat.new_book_list",
1821 (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1823 my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1824 print $header.$content;
1825 return Apache2::Const::OK;
1828 our %qualifier_ids = (
1829 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1830 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1831 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1835 # Our authority search options are currently pretty impoverished;
1836 # just right-truncated string match on a few categories, or by
1838 our %nested_auth_qualifier_map = (
1840 id => { index => 'id', title => 'Record number'},
1841 name => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1842 title => { index => 'title', title => 'Uniform title'},
1843 subject => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1844 topic => { index => 'topic', title => 'Topical term'},
1848 my $base_explain = <<XML;
1850 id="evergreen-sru-explain-full"
1851 authoritative="true"
1852 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1853 xmlns="http://explain.z3950.org/dtd/2.0/">
1854 <serverInfo transport="http" protocol="SRU" version="1.1">
1861 <title primary="true"/>
1862 <description primary="true"/>
1866 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1871 identifier="info:srw/schema/1/marcxml-v1.1"
1872 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1876 <title>MARC21Slim (marcxml)</title>
1881 <default type="numberOfRecords">10</default>
1882 <default type="contextSet">eg</default>
1883 <default type="index">keyword</default>
1884 <default type="relation">all</default>
1885 <default type="sortSchema">marcxml</default>
1886 <default type="retrieveSchema">marcxml</default>
1887 <setting type="maximumRecords">50</setting>
1888 <supports type="relationModifier">relevant</supports>
1889 <supports type="relationModifier">stem</supports>
1890 <supports type="relationModifier">fuzzy</supports>
1891 <supports type="relationModifier">word</supports>
1904 my $req = SRU::Request->newFromCGI( $cgi );
1905 my $resp = SRU::Response->newFromRequest( $req );
1907 # Find the org_unit shortname, if passed as part of the URL
1908 # http://example.com/opac/extras/sru/SHORTNAME
1909 my $url = $cgi->path_info;
1910 my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1912 if ( $resp->type eq 'searchRetrieve' ) {
1914 # Older versions of Debian packages returned terms to us double-encoded,
1915 # so we had to forcefully double-decode them a second time with
1916 # an outer decode('utf8', $string) call; this seems to be resolved with
1917 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1918 my $cql_query = decode_utf8($req->query);
1919 my $search_string = decode_utf8($req->cql->toEvergreen);
1921 # Ensure the search string overrides the default site
1922 if ($shortname and $search_string !~ m#site:#) {
1923 $search_string .= " site:$shortname";
1926 my $offset = $req->startRecord;
1927 $offset-- if ($offset);
1930 my $limit = $req->maximumRecords;
1933 $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1935 my $recs = $search->request(
1936 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1939 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1941 foreach my $record (@$bre) {
1942 my $marcxml = $record->marc;
1943 # Make the beast conform to a VDX-supported format
1944 # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1945 # Trying to implement LIBSOL_852_A format; so much for standards
1947 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1948 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1950 # Force record leader to 'a' as our data is always UTF8
1951 # Avoids marc8_to_utf8 from being invoked with horrible results
1952 # on the off-chance the record leader isn't correct
1953 my $ldr = $marc->leader;
1954 substr($ldr, 9, 1, 'a');
1955 $marc->leader($ldr);
1957 # Expects the record ID in the 001
1958 $marc->delete_field($_) for ($marc->field('001'));
1959 if (!$marc->field('001')) {
1960 $marc->insert_fields_ordered(
1961 MARC::Field->new( '001', $record->id )
1964 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1965 foreach my $cn (keys %$bib_holdings) {
1966 foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1967 $marc->insert_fields_ordered(
1970 a => $cp->{'location'},
1971 b => $bib_holdings->{$cn}->{'owning_lib'},
1973 d => $cp->{'circlib'},
1974 g => $cp->{'barcode'},
1975 n => $cp->{'status'},
1981 # Ensure the data is encoded as UTF8 before we hand it off
1982 $marcxml = encode_utf8($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' );
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' );
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