Respect a setting of depth=0. In particular, this fixes holdings requests for branch...
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / WWW / SuperCat.pm
1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
3
4 use Apache2::Log;
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;
10 use CGI;
11 use Data::Dumper;
12 use SRU::Request;
13 use SRU::Response;
14
15 use OpenSRF::EX qw(:try);
16 use OpenSRF::Utils qw/:datetime/;
17 use OpenSRF::Utils::Cache;
18 use OpenSRF::System;
19 use OpenSRF::AppSession;
20 use XML::LibXML;
21 use XML::LibXSLT;
22
23 use Encode;
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;
29
30 use MARC::Record;
31 use MARC::File::XML;
32
33 my $log = 'OpenSRF::Utils::Logger';
34 my $U = 'OpenILS::Application::AppUtils';
35
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);
38
39 $browse_types{call_number}{xml} = sub {
40     my $tree = shift;
41
42     my $year = (gmtime())[5] + 1900;
43     my $content = '';
44
45     $content .= "<volumes  xmlns='http://open-ils.org/spec/holdings/v1'>\n";
46
47     for my $cn (@$tree) {
48         (my $cn_class = $cn->class_name) =~ s/::/-/gso;
49         $cn_class =~ s/Fieldmapper-//gso;
50
51         my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
52         my $cn_lib = $cn->owning_lib->shortname;
53         my $cn_label = $cn->label;
54
55         $cn_label =~ s/\n//gos;
56         $cn_label =~ s/&/&amp;/go;
57         $cn_label =~ s/'/&apos;/go;
58         $cn_label =~ s/</&lt;/go;
59         $cn_label =~ s/>/&gt;/go;
60
61         (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
62         $ou_class =~ s/Fieldmapper-//gso;
63
64         my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
65         my $ou_name = $cn->owning_lib->name;
66
67         $ou_name =~ s/\n//gos;
68         $ou_name =~ s/'/&apos;/go;
69
70         (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
71         $rec_class =~ s/Fieldmapper-//gso;
72
73         my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
74
75         $content .= "<volume id='$cn_tag' lib='$cn_lib' label='$cn_label'>\n";
76         $content .= "<owning_lib xmlns='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>\n";
77
78         my $r_doc = $parser->parse_string($cn->record->marc);
79         $r_doc->documentElement->setAttribute( id => $rec_tag );
80         $content .= $U->entityize($r_doc->documentElement->toString);
81
82         $content .= "</volume>\n";
83     }
84
85     $content .= "</volumes>\n";
86     return ("Content-type: application/xml\n\n",$content);
87 };
88
89
90 $browse_types{call_number}{html} = sub {
91     my $tree = shift;
92     my $p = shift;
93     my $n = shift;
94
95     if (!$cn_browse_xslt) {
96         $cn_browse_xslt = $parser->parse_file(
97                 OpenSRF::Utils::SettingsClient
98                         ->new
99                         ->config_value( dirs => 'xsl' ).
100                 "/CNBrowse2HTML.xsl"
101         );
102         $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
103     }
104
105     my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
106
107     return (
108         "Content-type: text/html\n\n",
109         $U->entityize(
110             $cn_browse_xslt->transform(
111                 $parser->parse_string( $xml ),
112                 'prev' => "'$p'",
113                 'next' => "'$n'"
114             )->toString(1)
115         )
116     );
117 };
118
119 sub import {
120     my $self = shift;
121     $bootstrap = shift;
122 }
123
124
125 sub child_init {
126     OpenSRF::System->bootstrap_client( config_file => $bootstrap );
127     
128     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
129     Fieldmapper->import(IDL => $idl);
130
131     $supercat = OpenSRF::AppSession->create('open-ils.supercat');
132     $actor = OpenSRF::AppSession->create('open-ils.actor');
133     $search = OpenSRF::AppSession->create('open-ils.search');
134     $parser = new XML::LibXML;
135     $xslt = new XML::LibXSLT;
136
137     $cn_browse_xslt = $parser->parse_file(
138             OpenSRF::Utils::SettingsClient
139                     ->new
140                     ->config_value( dirs => 'xsl' ).
141             "/CNBrowse2HTML.xsl"
142     );
143
144     $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
145
146     %qualifier_map = %{$supercat
147         ->request("open-ils.supercat.biblio.search_aliases")
148         ->gather(1)};
149
150     my %attribute_desc = (
151         site        => 'Evergreen Site Code (shortname)',
152         sort        => 'Sort on relevance, title, author, pubdate, create_date or edit_date',
153         dir         => 'Sort direction (asc|desc)',
154         available   => 'Filter to available (true|false)',
155     );
156
157     # Append the non-search-alias attributes to the qualifier map
158     foreach ( qw/
159             available
160             ascending
161             descending
162             sort
163             format
164             before
165             after
166             statuses
167             locations
168             site
169             depth
170             lasso
171             offset
172             limit
173             preferred_language
174             preferred_language_weight
175             preferred_language_multiplier
176         /) {
177         $qualifier_map{'eg'}{$_}{'index'} = $_;
178         if (exists $attribute_desc{$_}) {
179             $qualifier_map{'eg'}{$_}{'title'} = $attribute_desc{$_};
180         } else {
181             $qualifier_map{'eg'}{$_}{'title'} = $_;
182         }
183     }
184
185     my $list = $supercat
186         ->request("open-ils.supercat.record.formats")
187         ->gather(1);
188
189     $list = [ map { (keys %$_)[0] } @$list ];
190     push @$list, 'htmlholdings','html', 'marctxt', 'ris';
191
192     for my $browse_axis ( qw/title author subject topic series item-age/ ) {
193         for my $record_browse_format ( @$list ) {
194             {
195                 my $__f = $record_browse_format;
196                 my $__a = $browse_axis;
197
198                 $browse_types{$__a}{$__f} = sub {
199                     my $record_list = shift;
200                     my $prev = shift;
201                     my $next = shift;
202                     my $real_format = shift || $__f;
203                     my $unapi = shift;
204                     my $base = shift;
205                     my $site = shift;
206
207                     $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
208                     my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
209                     $feed->root( "$base/../" );
210                     $feed->lib( $site );
211                     $feed->link( next => $next => $feed->type );
212                     $feed->link( previous => $prev => $feed->type );
213
214                     return (
215                         "Content-type: ". $feed->type ."; charset=utf-8\n\n",
216                         $feed->toString
217                     );
218                 };
219             }
220         }
221     }
222
223     for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
224         for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
225             {
226                 my $__f = 'marcxml';
227                 my $__a = $browse_axis;
228
229                 $browse_types{$__a}{$__f} = sub {
230                     my $record_list = shift;
231                     my $prev = shift;
232                     my $next = shift;
233                     my $real_format = shift || $__f;
234                     my $unapi = shift;
235                     my $base = shift;
236                     my $site = shift;
237
238                     $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
239                     my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
240                     $feed->root( "$base/../" );
241                     $feed->link( next => $next => $feed->type );
242                     $feed->link( previous => $prev => $feed->type );
243
244                     return (
245                         "Content-type: ". $feed->type ."; charset=utf-8\n\n",
246                         $feed->toString
247                     );
248                 };
249             }
250         }
251     }
252 }
253
254 =head2 parse_feed_type($type)
255
256 Determines whether and how a given feed type needs to be "fleshed out"
257 with holdings information.
258
259 The feed type could end with the string "-full", in which case we want
260 to return call numbers, copies, and URIS.
261
262 Or the feed type could be "-uris", in which case we want to return
263 call numbers and URIS.
264
265 Otherwise, we won't return any holdings.
266
267 =cut
268
269 sub parse_feed_type {
270     my $type = shift;
271
272      if ($type =~ /-full$/o) {
273         return 1;
274     }
275
276      if ($type =~ /-uris$/o) {
277         return "uris";
278     }
279
280     # Otherwise, we'll return just the facts, ma'am
281     return 0;
282 }
283
284 =head2 supercat_format($format_hashref, $format_type)
285
286 Given a reference to a hash containing the namespace_uri,
287 docs, and schema location attributes for a set of formats,
288 generate the XML description required by the supercat service.
289
290 We derive the base type from the format type so that we do not
291 have to populate the hash with redundant information.
292
293 =cut
294
295 sub supercat_format {
296     my $h = shift;
297     my $type = shift;
298
299     (my $base_type = $type) =~ s/(-full|-uris)$//o;
300
301     my $format = "<format><name>$type</name><type>application/xml</type>";
302
303     for my $part ( qw/namespace_uri docs schema_location/ ) {
304         $format .= "<$part>$$h{$base_type}{$part}</$part>"
305             if ($$h{$base_type}{$part});
306     }
307
308     $format .= '</format>';
309
310     return $format;
311 }
312
313 =head2 unapi_format($format_hashref, $format_type)
314
315 Given a reference to a hash containing the namespace_uri,
316 docs, and schema location attributes for a set of formats,
317 generate the XML description required by the supercat service.
318
319 We derive the base type from the format type so that we do not
320 have to populate the hash with redundant information.
321
322 =cut
323
324 sub unapi_format {
325     my $h = shift;
326     my $type = shift;
327
328     (my $base_type = $type) =~ s/(-full|-uris)$//o;
329
330     my $format = "<format name='$type' type='application/xml'";
331
332     for my $part ( qw/namespace_uri docs schema_location/ ) {
333         $format .= " $part='$$h{$base_type}{$part}'"
334             if ($$h{$base_type}{$part});
335     }
336
337     $format .= "/>\n";
338
339     return $format;
340 }
341
342
343 sub oisbn {
344
345     my $apache = shift;
346     return Apache2::Const::DECLINED if (-e $apache->filename);
347
348     (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
349
350     my $list = $supercat
351         ->request("open-ils.supercat.oisbn", $isbn)
352         ->gather(1);
353
354     print "Content-type: application/xml; charset=utf-8\n\n";
355     print "<?xml version='1.0' encoding='UTF-8' ?>\n";
356
357     unless (exists $$list{metarecord}) {
358         print '<idlist/>';
359         return Apache2::Const::OK;
360     }
361
362     print "<idlist metarecord='$$list{metarecord}'>\n";
363
364     for ( keys %{ $$list{record_list} } ) {
365         (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
366         print "  <isbn record='$_'>$o</isbn>\n"
367     }
368
369     print "</idlist>\n";
370
371     return Apache2::Const::OK;
372 }
373
374 sub unapi {
375
376     my $apache = shift;
377     return Apache2::Const::DECLINED if (-e $apache->filename);
378
379     my $cgi = new CGI;
380
381     my $add_path = 0;
382     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
383         my $rel_name = $cgi->url(-relative=>1);
384         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
385     }
386
387     my $url = $cgi->url(-path_info=>$add_path);
388     my $root = (split 'unapi', $url)[0];
389     my $base = (split 'unapi', $url)[0] . 'unapi';
390
391
392     my $uri = $cgi->param('id') || '';
393     my $host = $cgi->virtual_host || $cgi->server_name;
394
395     my $skin = $cgi->param('skin') || 'default';
396     my $locale = $cgi->param('locale') || 'en-US';
397
398     # Enable localized results of copy status, etc
399     $supercat->session_locale($locale);
400
401     my $format = $cgi->param('format');
402     my $flesh_feed = parse_feed_type($format);
403     (my $base_format = $format) =~ s/(-full|-uris)$//o;
404     my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
405
406     if (!$format) {
407         my $body = "Content-type: application/xml; charset=utf-8\n\n";
408     
409         if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
410             $id = $2;
411             $paging = $3;
412             ($lib,$depth) = split('/', $4);
413             $type = 'record';
414             $type = 'metarecord' if ($1 =~ /^m/o);
415             $type = 'authority' if ($1 =~ /^authority/o);
416
417             my $list = $supercat
418                 ->request("open-ils.supercat.$type.formats")
419                 ->gather(1);
420
421             if ($type eq 'record' or $type eq 'isbn') {
422                 $body .= <<"                FORMATS";
423 <formats id='$uri'>
424     <format name='opac' type='text/html'/>
425     <format name='html' type='text/html'/>
426     <format name='htmlholdings' type='text/html'/>
427     <format name='holdings_xml' type='application/xml'/>
428     <format name='holdings_xml-full' type='application/xml'/>
429     <format name='html-full' type='text/html'/>
430     <format name='htmlholdings-full' type='text/html'/>
431     <format name='marctxt' type='text/plain'/>
432     <format name='ris' type='text/plain'/>
433                 FORMATS
434             } elsif ($type eq 'metarecord') {
435                 $body .= <<"                FORMATS";
436                 <formats id='$uri'>
437                     <format name='opac' type='text/html'/>
438                 FORMATS
439             } else {
440                 $body .= <<"                FORMATS";
441                 <formats id='$uri'>
442                 FORMATS
443             }
444
445             for my $h (@$list) {
446                 my ($type) = keys %$h;
447                 $body .= unapi_format($h, $type);
448
449                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
450                     $body .= unapi_format($h, "$type-full");
451                     $body .= unapi_format($h, "$type-uris");
452                 }
453             }
454
455             $body .= "</formats>\n";
456
457         } else {
458             my $list = $supercat
459                 ->request("open-ils.supercat.$type.formats")
460                 ->gather(1);
461                 
462             push @$list,
463                 @{ $supercat
464                     ->request("open-ils.supercat.metarecord.formats")
465                     ->gather(1);
466                 };
467
468             my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
469             $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
470
471             $body .= <<"            FORMATS";
472 <formats>
473     <format name='opac' type='text/html'/>
474     <format name='html' type='text/html'/>
475     <format name='htmlholdings' type='text/html'/>
476     <format name='holdings_xml' type='application/xml'/>
477     <format name='holdings_xml-full' type='application/xml'/>
478     <format name='html-full' type='text/html'/>
479     <format name='htmlholdings-full' type='text/html'/>
480     <format name='marctxt' type='text/plain'/>
481     <format name='ris' type='text/plain'/>
482             FORMATS
483
484
485             for my $h (@$list) {
486                 my ($type) = keys %$h;
487                 $body .= "\t" . unapi_format($h, $type);
488
489                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
490                     $body .= "\t" . unapi_format($h, "$type-full");
491                     $body .= "\t" . unapi_format($h, "$type-uris");
492                 }
493             }
494
495             $body .= "</formats>\n";
496
497         }
498         print $body;
499         return Apache2::Const::OK;
500     }
501
502     my $scheme;
503     if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
504         $scheme = $1;
505         $id = $2;
506         $paging = $3;
507         ($lib,$depth) = split('/', $4);
508         $type = 'record';
509         $type = 'metarecord' if ($scheme =~ /^metabib/o);
510         $type = 'isbn' if ($scheme =~ /^isbn/o);
511         $type = 'acp' if ($scheme =~ /^asset-copy/o);
512         $type = 'acn' if ($scheme =~ /^asset-call_number/o);
513         $type = 'auri' if ($scheme =~ /^asset-uri/o);
514         $type = 'authority' if ($scheme =~ /^authority/o);
515         $command = 'retrieve';
516         $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
517     }
518
519     if ($paging) {
520         $paging = [split ',', $paging];
521     } else {
522         $paging = [];
523     }
524
525     if (!$lib || $lib eq '-') {
526          $lib = $actor->request(
527             'open-ils.actor.org_unit_list.search' => parent_ou => undef
528         )->gather(1)->[0]->shortname;
529     }
530
531     my ($lib_object,$lib_id,$ou_types,$lib_depth);
532     if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
533         $lib_object = $actor->request(
534             'open-ils.actor.org_unit_list.search' => shortname => $lib
535         )->gather(1)->[0];
536         $lib_id = $lib_object->id;
537
538         $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
539         $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
540     }
541
542     if ($command eq 'browse') {
543         print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
544         return 302;
545     }
546
547     if ($type eq 'isbn') {
548         my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
549         if (!@$rec) {
550             print "Content-type: text/html; charset=utf-8\n\n";
551             $apache->custom_response( 404, <<"            HTML");
552             <html>
553                 <head>
554                     <title>Type [$type] with id [$id] not found!</title>
555                 </head>
556                 <body>
557                     <br/>
558                     <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
559                 </body>
560             </html>
561             HTML
562             return 404;
563         }
564         $id = $rec->[0]->id;
565         $type = 'record';
566     }
567
568     if ( !grep
569            { (keys(%$_))[0] eq $base_format }
570            @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
571          and !grep
572            { $_ eq $base_format }
573            qw/opac html htmlholdings marctxt ris holdings_xml/
574     ) {
575         print "Content-type: text/html; charset=utf-8\n\n";
576         $apache->custom_response( 406, <<"        HTML");
577         <html>
578             <head>
579                 <title>Invalid format [$format] for type [$type]!</title>
580             </head>
581             <body>
582                 <br/>
583                 <center>Sorry, format $format is not valid for type $type.</center>
584             </body>
585         </html>
586         HTML
587         return 406;
588     }
589
590     if ($format eq 'opac') {
591         print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
592             if ($type eq 'metarecord');
593         print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
594             if ($type eq 'record');
595         return 302;
596     } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
597         my $feed = create_record_feed(
598             $type,
599             $format => [ $id ],
600             $base,
601             $lib,
602             $depth,
603             $flesh_feed,
604             $paging
605         );
606
607         if (!$feed->count) {
608             print "Content-type: text/html; charset=utf-8\n\n";
609             $apache->custom_response( 404, <<"            HTML");
610             <html>
611                 <head>
612                     <title>Type [$type] with id [$id] not found!</title>
613                 </head>
614                 <body>
615                     <br/>
616                     <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
617                 </body>
618             </html>
619             HTML
620             return 404;
621         }
622
623         $feed->root($root);
624         $feed->creator($host);
625         $feed->update_ts();
626         $feed->link( unapi => $base) if ($flesh_feed);
627
628         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
629         print $U->entityize($feed->toString) . "\n";
630
631         return Apache2::Const::OK;
632     }
633
634     my $method = "open-ils.supercat.$type.$base_format.$command";
635     my @params = ($id);
636     push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
637
638     # for acn, acp, etc, the "lib" pathinfo position isn't useful.
639     # however, we can have it carry extra options like no_record! (comma separated)
640     push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
641
642     my $req = $supercat->request($method,@params);
643     my $data = $req->gather();
644
645     if ($req->failed || !$data) {
646         print "Content-type: text/html; charset=utf-8\n\n";
647         $apache->custom_response( 404, <<"        HTML");
648         <html>
649             <head>
650                 <title>$type $id not found!</title>
651             </head>
652             <body>
653                 <br/>
654                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
655             </body>
656         </html>
657         HTML
658         return 404;
659     }
660
661     print "Content-type: application/xml; charset=utf-8\n\n$data";
662
663     if ($base_format eq 'holdings_xml') {
664         while (my $c = $req->recv) {
665             print $c->content;
666         }
667     }
668
669     return Apache2::Const::OK;
670 }
671
672 sub supercat {
673
674     my $apache = shift;
675     return Apache2::Const::DECLINED if (-e $apache->filename);
676
677     my $cgi = new CGI;
678
679     my $add_path = 0;
680     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
681         my $rel_name = $cgi->url(-relative=>1);
682         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
683     }
684
685     my $url = $cgi->url(-path_info=>$add_path);
686     my $root = (split 'supercat', $url)[0];
687     my $base = (split 'supercat', $url)[0] . 'supercat';
688     my $unapi = (split 'supercat', $url)[0] . 'unapi';
689
690     my $host = $cgi->virtual_host || $cgi->server_name;
691
692     my $path = $cgi->path_info;
693     my ($id,$type,$format,$command) = reverse split '/', $path;
694     my $flesh_feed = parse_feed_type($format);
695     (my $base_format = $format) =~ s/(-full|-uris)$//o;
696
697     my $skin = $cgi->param('skin') || 'default';
698     my $locale = $cgi->param('locale') || 'en-US';
699
700     # Enable localized results of copy status, etc
701     $supercat->session_locale($locale);
702     
703     if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
704         print "Content-type: application/xml; charset=utf-8\n";
705         if ($1) {
706             my $list = $supercat
707                 ->request("open-ils.supercat.$1.formats")
708                 ->gather(1);
709
710             print "\n";
711
712             print "<formats>
713                    <format>
714                      <name>opac</name>
715                      <type>text/html</type>
716                    </format>";
717
718             if ($1 eq 'record' or $1 eq 'isbn') {
719                 print "<format>
720                      <name>htmlholdings</name>
721                      <type>text/html</type>
722                    </format>
723                    <format>
724                      <name>html</name>
725                      <type>text/html</type>
726                    </format>
727                    <format>
728                      <name>htmlholdings-full</name>
729                      <type>text/html</type>
730                    </format>
731                    <format>
732                      <name>html-full</name>
733                      <type>text/html</type>
734                    </format>
735                    <format>
736                      <name>marctxt</name>
737                      <type>text/plain</type>
738                    </format>
739                    <format>
740                      <name>ris</name>
741                      <type>text/plain</type>
742                    </format>";
743             }
744
745             for my $h (@$list) {
746                 my ($type) = keys %$h;
747                 print supercat_format($h, $type);
748
749                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
750                     print supercat_format($h, "$type-full");
751                     print supercat_format($h, "$type-uris");
752                 }
753
754             }
755
756             print "</formats>\n";
757
758             return Apache2::Const::OK;
759         }
760
761         my $list = $supercat
762             ->request("open-ils.supercat.record.formats")
763             ->gather(1);
764                 
765         push @$list,
766             @{ $supercat
767                 ->request("open-ils.supercat.metarecord.formats")
768                 ->gather(1);
769             };
770
771         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
772         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
773
774         print "\n<formats>
775                <format>
776                  <name>opac</name>
777                  <type>text/html</type>
778                </format>
779                <format>
780                  <name>htmlholdings</name>
781                  <type>text/html</type>
782                </format>
783                <format>
784                  <name>html</name>
785                  <type>text/html</type>
786                </format>
787                <format>
788                  <name>htmlholdings-full</name>
789                  <type>text/html</type>
790                </format>
791                <format>
792                  <name>html-full</name>
793                  <type>text/html</type>
794                </format>
795                <format>
796                  <name>marctxt</name>
797                  <type>text/plain</type>
798                </format>
799                <format>
800                  <name>ris</name>
801                  <type>text/plain</type>
802                </format>";
803
804         for my $h (@$list) {
805             my ($type) = keys %$h;
806             print supercat_format($h, $type);
807
808             if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
809                 print supercat_format($h, "$type-full");
810                 print supercat_format($h, "$type-uris");
811             }
812
813         }
814
815         print "</formats>\n";
816
817
818         return Apache2::Const::OK;
819     }
820
821     if ($format eq 'opac') {
822         print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
823             if ($type eq 'metarecord');
824         print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
825             if ($type eq 'record');
826         return 302;
827
828     } elsif ($base_format eq 'marc21') {
829
830         my $ret = 200;    
831         try {
832             my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
833         
834             print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
835
836         } otherwise {
837             warn shift();
838             
839             print "Content-type: text/html; charset=utf-8\n\n";
840             $apache->custom_response( 404, <<"            HTML");
841             <html>
842                 <head>
843                     <title>ERROR</title>
844                 </head>
845                 <body>
846                     <br/>
847                     <center>Couldn't fetch $id as MARC21.</center>
848                 </body>
849             </html>
850             HTML
851             $ret = 404;
852         };
853
854         return Apache2::Const::OK;
855
856     } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
857         my $feed = create_record_feed(
858             $type,
859             $format => [ $id ],
860             undef, undef, undef,
861             $flesh_feed
862         );
863
864         $feed->root($root);
865         $feed->creator($host);
866
867         $feed->update_ts();
868
869         $feed->link( unapi => $base) if ($flesh_feed);
870
871         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
872         print $U->entityize($feed->toString) . "\n";
873
874         return Apache2::Const::OK;
875     }
876
877     my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
878     $req->wait_complete;
879
880     if ($req->failed) {
881         print "Content-type: text/html; charset=utf-8\n\n";
882         $apache->custom_response( 404, <<"        HTML");
883         <html>
884             <head>
885                 <title>$type $id not found!</title>
886             </head>
887             <body>
888                 <br/>
889                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
890             </body>
891         </html>
892         HTML
893         return 404;
894     }
895
896     print "Content-type: application/xml; charset=utf-8\n\n";
897     print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
898
899     return Apache2::Const::OK;
900 }
901
902
903 sub bookbag_feed {
904     my $apache = shift;
905     return Apache2::Const::DECLINED if (-e $apache->filename);
906
907     my $cgi = new CGI;
908
909     my $year = (gmtime())[5] + 1900;
910     my $host = $cgi->virtual_host || $cgi->server_name;
911
912     my $add_path = 0;
913     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
914         my $rel_name = $cgi->url(-relative=>1);
915         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
916     }
917
918     my $url = $cgi->url(-path_info=>$add_path);
919     my $root = (split 'feed', $url)[0] . '/';
920     my $base = (split 'bookbag', $url)[0] . '/bookbag';
921     my $unapi = (split 'feed', $url)[0] . '/unapi';
922
923     my $skin = $cgi->param('skin') || 'default';
924     my $locale = $cgi->param('locale') || 'en-US';
925     my $org = $cgi->param('searchOrg');
926
927     # Enable localized results of copy status, etc
928     $supercat->session_locale($locale);
929
930     my $org_unit = get_ou($org);
931     my $scope = "l=" . $org_unit->[0]->id . "&";
932
933     $root =~ s{(?<!http:)//}{/}go;
934     $base =~ s{(?<!http:)//}{/}go;
935     $unapi =~ s{(?<!http:)//}{/}go;
936
937     my $path = $cgi->path_info;
938     #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
939
940     my ($id,$type) = reverse split '/', $path;
941     my $flesh_feed = parse_feed_type($type);
942
943     my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
944     return Apache2::Const::NOT_FOUND unless($bucket);
945
946     my $bucket_tag = "tag:$host,$year:record_bucket/$id";
947     if ($type eq 'opac') {
948         print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
949             join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
950             "\n\n";
951         return 302;
952     }
953
954     my $feed = create_record_feed(
955         'record',
956         $type,
957         [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
958         $unapi,
959         $org_unit->[0]->shortname,
960         undef,
961         $flesh_feed
962     );
963     $feed->root($root);
964     $feed->id($bucket_tag);
965
966     $feed->title("Items in Book Bag [".$bucket->name."]");
967     $feed->creator($host);
968     $feed->update_ts();
969
970     $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
971     $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
972     $feed->link(html => $base . "/html-full/$id" => 'text/html');
973     $feed->link(unapi => $unapi);
974
975     $feed->link(
976         OPAC =>
977         "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
978             join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
979         'text/html'
980     );
981
982
983     print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
984     print $U->entityize($feed->toString) . "\n";
985
986     return Apache2::Const::OK;
987 }
988
989 sub changes_feed {
990     my $apache = shift;
991     return Apache2::Const::DECLINED if (-e $apache->filename);
992
993     my $cgi = new CGI;
994
995     my $year = (gmtime())[5] + 1900;
996     my $host = $cgi->virtual_host || $cgi->server_name;
997
998     my $add_path = 0;
999     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1000         my $rel_name = $cgi->url(-relative=>1);
1001         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1002     }
1003
1004     my $url = $cgi->url(-path_info=>$add_path);
1005     my $root = (split 'feed', $url)[0];
1006     my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1007     my $unapi = (split 'feed', $url)[0] . 'unapi';
1008
1009     my $skin = $cgi->param('skin') || 'default';
1010     my $locale = $cgi->param('locale') || 'en-US';
1011     my $org = $cgi->param('searchOrg');
1012
1013     # Enable localized results of copy status, etc
1014     $supercat->session_locale($locale);
1015
1016     my $org_unit = get_ou($org);
1017     my $scope = "l=" . $org_unit->[0]->id . "&";
1018
1019     my $path = $cgi->path_info;
1020     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1021
1022     $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1023     
1024     my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1025     my $flesh_feed = parse_feed_type($type);
1026
1027     $limit ||= 10;
1028     $limit = 10 if $limit !~ /^\d+$/;
1029
1030     my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1031
1032     #if ($type eq 'opac') {
1033     #    print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
1034     #        join('&', map { "rl=" . $_ } @$list) .
1035     #        "\n\n";
1036     #    return 302;
1037     #}
1038
1039     my $search = 'record';
1040     if ($rtype eq 'authority') {
1041         $search = 'authority';
1042     }
1043     my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1044     $feed->root($root);
1045
1046     if ($date) {
1047         $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1048     } else {
1049         $feed->title("$limit most recent $rtype ${axis}s");
1050     }
1051
1052     $feed->creator($host);
1053     $feed->update_ts();
1054
1055     $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1056     $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1057     $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1058     $feed->link(unapi => $unapi);
1059
1060     $feed->link(
1061         OPAC =>
1062         "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1063             join('&', map { 'rl=' . $_} @$list ),
1064         'text/html'
1065     );
1066
1067
1068     print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1069     print $U->entityize($feed->toString) . "\n";
1070
1071     return Apache2::Const::OK;
1072 }
1073
1074 sub opensearch_osd {
1075     my $version = shift;
1076     my $lib = shift;
1077     my $class = shift;
1078     my $base = shift;
1079
1080     if ($version eq '1.0') {
1081         print <<OSD;
1082 Content-type: application/opensearchdescription+xml; charset=utf-8
1083
1084 <?xml version="1.0" encoding="UTF-8"?>
1085 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1086   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&amp;startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
1087   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1088   <ShortName>$lib</ShortName>
1089   <LongName>Search $lib</LongName>
1090   <Description>Search the $lib OPAC by $class.</Description>
1091   <Tags>$lib book library</Tags>
1092   <SampleSearch>harry+potter</SampleSearch>
1093   <Developer>Mike Rylander for GPLS/PINES</Developer>
1094   <Contact>feedback\@open-ils.org</Contact>
1095   <SyndicationRight>open</SyndicationRight>
1096   <AdultContent>false</AdultContent>
1097 </OpenSearchDescription>
1098 OSD
1099     } else {
1100         print <<OSD;
1101 Content-type: application/opensearchdescription+xml; charset=utf-8
1102
1103 <?xml version="1.0" encoding="UTF-8"?>
1104 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1105   <ShortName>$lib</ShortName>
1106   <Description>Search the $lib OPAC by $class.</Description>
1107   <Tags>$lib book library</Tags>
1108   <Url type="application/rss+xml"
1109        template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1110   <Url type="application/atom+xml"
1111        template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1112   <Url type="application/x-mods3+xml"
1113        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1114   <Url type="application/x-mods+xml"
1115        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1116   <Url type="application/x-marcxml+xml"
1117        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1118   <Url type="text/html"
1119        template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1120   <LongName>Search $lib</LongName>
1121   <Query role="example" searchTerms="harry+potter" />
1122   <Developer>Mike Rylander for GPLS/PINES</Developer>
1123   <Contact>feedback\@open-ils.org</Contact>
1124   <SyndicationRight>open</SyndicationRight>
1125   <AdultContent>false</AdultContent>
1126   <Language>en-US</Language>
1127   <OutputEncoding>UTF-8</OutputEncoding>
1128   <InputEncoding>UTF-8</InputEncoding>
1129 </OpenSearchDescription>
1130 OSD
1131     }
1132
1133     return Apache2::Const::OK;
1134 }
1135
1136 sub opensearch_feed {
1137     my $apache = shift;
1138     return Apache2::Const::DECLINED if (-e $apache->filename);
1139
1140     my $cgi = new CGI;
1141     my $year = (gmtime())[5] + 1900;
1142
1143     my $host = $cgi->virtual_host || $cgi->server_name;
1144
1145     my $add_path = 0;
1146     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1147         my $rel_name = $cgi->url(-relative=>1);
1148         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1149     }
1150
1151     my $url = $cgi->url(-path_info=>$add_path);
1152     my $root = (split 'opensearch', $url)[0];
1153     my $base = (split 'opensearch', $url)[0] . 'opensearch';
1154     my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1155
1156     my $path = $cgi->path_info;
1157     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1158
1159     if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1160         
1161         my $version = $1;
1162         my $lib = uc($2);
1163         my $class = $3;
1164
1165         if (!$lib || $lib eq '-') {
1166              $lib = $actor->request(
1167                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1168             )->gather(1)->[0]->shortname;
1169         }
1170
1171         if ($class eq '-') {
1172             $class = 'keyword';
1173         }
1174
1175         return opensearch_osd($version, $lib, $class, $base);
1176     }
1177
1178
1179     my $page = $cgi->param('startPage') || 1;
1180     my $offset = $cgi->param('startIndex') || 1;
1181     my $limit = $cgi->param('count') || 10;
1182
1183     $page = 1 if ($page !~ /^\d+$/);
1184     $offset = 1 if ($offset !~ /^\d+$/);
1185     $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1186
1187     if ($page > 1) {
1188         $offset = ($page - 1) * $limit;
1189     } else {
1190         $offset -= 1;
1191     }
1192
1193     my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1194     (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1195
1196     $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1197     $lang = '' if ($lang eq '*');
1198
1199     $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1200     $sort ||= '';
1201     $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1202     $sortdir ||= '';
1203
1204     $terms .= " " if ($terms && $cgi->param('searchTerms'));
1205     $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1206
1207     $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1208     $class ||= '-';
1209
1210     $type = $cgi->param('responseType') if $cgi->param('responseType');
1211     $type ||= '-';
1212
1213     $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1214     $org ||= '-';
1215
1216
1217     my $kwt = $cgi->param('kw');
1218     my $tit = $cgi->param('ti');
1219     my $aut = $cgi->param('au');
1220     my $sut = $cgi->param('su');
1221     my $set = $cgi->param('se');
1222
1223     $terms .= " " if ($terms && $kwt);
1224     $terms .= "keyword: $kwt" if ($kwt);
1225     $terms .= " " if ($terms && $tit);
1226     $terms .= "title: $tit" if ($tit);
1227     $terms .= " " if ($terms && $aut);
1228     $terms .= "author: $aut" if ($aut);
1229     $terms .= " " if ($terms && $sut);
1230     $terms .= "subject: $sut" if ($sut);
1231     $terms .= " " if ($terms && $set);
1232     $terms .= "series: $set" if ($set);
1233
1234     if ($version eq '1.0') {
1235         $type = 'rss2';
1236     } elsif ($type eq '-') {
1237         $type = 'atom';
1238     }
1239     my $flesh_feed = parse_feed_type($type);
1240
1241     $terms = decode_utf8($terms);
1242     $lang = 'eng' if ($lang eq 'en-US');
1243
1244     $log->debug("OpenSearch terms: $terms");
1245
1246     my $org_unit = get_ou($org);
1247
1248     # Apostrophes break search and get indexed as spaces anyway
1249     my $safe_terms = $terms;
1250     $safe_terms =~ s{'}{ }go;
1251
1252     my $recs = $search->request(
1253         'open-ils.search.biblio.multiclass.query' => {
1254             org_unit    => $org_unit->[0]->id,
1255             offset        => $offset,
1256             limit        => $limit,
1257             sort        => $sort,
1258             sort_dir    => $sortdir,
1259             default_class => $class,
1260             ($lang ?    ( 'language' => $lang    ) : ()),
1261         } => $safe_terms => 1
1262     )->gather(1);
1263
1264     $log->debug("Hits for [$terms]: $recs->{count}");
1265
1266     my $feed = create_record_feed(
1267         'record',
1268         $type,
1269         [ map { $_->[0] } @{$recs->{ids}} ],
1270         $unapi,
1271         $org,
1272         undef,
1273         $flesh_feed
1274     );
1275
1276     $log->debug("Feed created...");
1277
1278     $feed->root($root);
1279     $feed->lib($org);
1280     $feed->search($safe_terms);
1281     $feed->class($class);
1282
1283     $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1284
1285     $feed->creator($host);
1286     $feed->update_ts();
1287
1288     $feed->_create_node(
1289         $feed->{item_xpath},
1290         'http://a9.com/-/spec/opensearch/1.1/',
1291         'totalResults',
1292         $recs->{count},
1293     );
1294
1295     $feed->_create_node(
1296         $feed->{item_xpath},
1297         'http://a9.com/-/spec/opensearch/1.1/',
1298         'startIndex',
1299         $offset + 1,
1300     );
1301
1302     $feed->_create_node(
1303         $feed->{item_xpath},
1304         'http://a9.com/-/spec/opensearch/1.1/',
1305         'itemsPerPage',
1306         $limit,
1307     );
1308
1309     $log->debug("...basic feed data added...");
1310
1311     $feed->link(
1312         next =>
1313         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1314         'application/opensearch+xml'
1315     ) if ($offset + $limit < $recs->{count});
1316
1317     $feed->link(
1318         previous =>
1319         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1320         'application/opensearch+xml'
1321     ) if ($offset);
1322
1323     $feed->link(
1324         self =>
1325         $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1326         'application/opensearch+xml'
1327     );
1328
1329     $feed->link(
1330         alternate =>
1331         $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1332         'application/rss+xml'
1333     );
1334
1335     $feed->link(
1336         atom =>
1337         $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1338         'application/atom+xml'
1339     );
1340
1341     $feed->link(
1342         'html' =>
1343         $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1344         'text/html'
1345     );
1346
1347     $feed->link(
1348         'html-full' =>
1349         $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1350         'text/html'
1351     );
1352
1353     $feed->link( 'unapi-server' => $unapi);
1354
1355     $log->debug("...feed links added...");
1356
1357 #    $feed->link(
1358 #        opac =>
1359 #        $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1360 #            join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1361 #        'text/html'
1362 #    );
1363
1364     #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1365     print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1366
1367     $log->debug("...and feed returned.");
1368
1369     return Apache2::Const::OK;
1370 }
1371
1372 sub create_record_feed {
1373     my $search = shift;
1374     my $type = shift;
1375     my $records = shift;
1376     my $unapi = shift;
1377
1378     my $lib = uc(shift()) || '-';
1379     my $depth = shift;
1380     my $flesh = shift;
1381
1382     my $paging = shift;
1383
1384     my $cgi = new CGI;
1385     my $base = $cgi->url;
1386     my $host = $cgi->virtual_host || $cgi->server_name;
1387
1388     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1389     $year += 1900;
1390     $month += 1;
1391
1392     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1393
1394     my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1395
1396     $type =~ s/(-full|-uris)$//o;
1397
1398     my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1399     $feed->base($base) if ($flesh);
1400     $feed->unapi($unapi) if ($flesh);
1401
1402     $type = 'atom' if ($type eq 'html');
1403     $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1404
1405     #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1406
1407     my $count = 0;
1408     for my $record (@$records) {
1409         next unless($record);
1410
1411         #my $rec = $record->id;
1412         my $rec = $record;
1413
1414         my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1415         $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1416         $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1417         $item_tag .= "/$depth" if (defined($depth));
1418
1419         $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1420
1421         my $xml = $supercat->request(
1422             "open-ils.supercat.$search.$type.retrieve",
1423             $rec
1424         )->gather(1);
1425         next unless $xml;
1426
1427         my $node = $feed->add_item($xml);
1428         next unless $node;
1429
1430         $xml = '';
1431         if ($lib && ($type eq 'marcxml' || $type eq 'atom') &&  $flesh > 0) {
1432             my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1433             while ( !$r->complete ) {
1434                 $xml .= join('', map {$_->content} $r->recv);
1435             }
1436             $xml .= join('', map {$_->content} $r->recv);
1437             $node->add_holdings($xml);
1438         }
1439
1440         $node->id($item_tag);
1441         #$node->update_ts(cleanse_ISO8601($record->edit_date));
1442         $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1443         $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1444         $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1445         $node->link('unapi-id' => $item_tag) if ($flesh);
1446     }
1447
1448     return $feed;
1449 }
1450
1451 sub string_browse {
1452     my $apache = shift;
1453     return Apache2::Const::DECLINED if (-e $apache->filename);
1454
1455     my $cgi = new CGI;
1456     my $year = (gmtime())[5] + 1900;
1457
1458     my $host = $cgi->virtual_host || $cgi->server_name;
1459
1460     my $add_path = 0;
1461     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1462         my $rel_name = $cgi->url(-relative=>1);
1463         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1464     }
1465
1466     my $url = $cgi->url(-path_info=>$add_path);
1467     my $root = (split 'browse', $url)[0];
1468     my $base = (split 'browse', $url)[0] . 'browse';
1469     my $unapi = (split 'browse', $url)[0] . 'unapi';
1470
1471     my $path = $cgi->path_info;
1472     $path =~ s/^\///og;
1473
1474     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1475     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1476
1477     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1478
1479     my $status = [$cgi->param('status')];
1480     my $cpLoc = [$cgi->param('copyLocation')];
1481     $site ||= $cgi->param('searchOrg');
1482     $page ||= $cgi->param('startPage') || 0;
1483     $page_size ||= $cgi->param('count') || 9;
1484
1485     $page = 0 if ($page !~ /^-?\d+$/);
1486     $page_size = 9 if $page_size !~ /^\d+$/;
1487
1488     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1489     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1490
1491     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1492         warn "something's wrong...";
1493         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1494         return undef;
1495     }
1496
1497     $string = decode_utf8($string);
1498     $string =~ s/\+/ /go;
1499     $string =~ s/'//go;
1500
1501     my $tree = $supercat->request(
1502         "open-ils.supercat.$axis.browse",
1503         $string,
1504         (($axis =~ /^authority/) ? () : ($site)),
1505         $page_size,
1506         $page,
1507         $status,
1508         $cpLoc
1509     )->gather(1);
1510
1511     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1512
1513     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1514     print $header.$content;
1515     return Apache2::Const::OK;
1516 }
1517
1518 sub string_startwith {
1519     my $apache = shift;
1520     return Apache2::Const::DECLINED if (-e $apache->filename);
1521
1522     my $cgi = new CGI;
1523     my $year = (gmtime())[5] + 1900;
1524
1525     my $host = $cgi->virtual_host || $cgi->server_name;
1526
1527     my $add_path = 0;
1528     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1529         my $rel_name = $cgi->url(-relative=>1);
1530         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1531     }
1532
1533     my $url = $cgi->url(-path_info=>$add_path);
1534     my $root = (split 'startwith', $url)[0];
1535     my $base = (split 'startwith', $url)[0] . 'startwith';
1536     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1537
1538     my $path = $cgi->path_info;
1539     $path =~ s/^\///og;
1540
1541     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1542     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1543
1544     my $status = [$cgi->param('status')];
1545     my $cpLoc = [$cgi->param('copyLocation')];
1546     $site ||= $cgi->param('searchOrg');
1547     $page ||= $cgi->param('startPage') || 0;
1548     $page_size ||= $cgi->param('count') || 9;
1549
1550     $page = 0 if ($page !~ /^-?\d+$/);
1551     $page_size = 9 if $page_size !~ /^\d+$/;
1552
1553     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1554     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1555
1556     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1557         warn "something's wrong...";
1558         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1559         return undef;
1560     }
1561
1562     $string = decode_utf8($string);
1563     $string =~ s/\+/ /go;
1564     $string =~ s/'//go;
1565
1566     my $tree = $supercat->request(
1567         "open-ils.supercat.$axis.startwith",
1568         $string,
1569         (($axis =~ /^authority/) ? () : ($site)),
1570         $page_size,
1571         $page,
1572         $status,
1573         $cpLoc
1574     )->gather(1);
1575
1576     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1577
1578     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1579     print $header.$content;
1580     return Apache2::Const::OK;
1581 }
1582
1583 sub item_age_browse {
1584     my $apache = shift;
1585     return Apache2::Const::DECLINED if (-e $apache->filename);
1586
1587     my $cgi = new CGI;
1588     my $year = (gmtime())[5] + 1900;
1589
1590     my $host = $cgi->virtual_host || $cgi->server_name;
1591
1592     my $add_path = 0;
1593     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1594         my $rel_name = $cgi->url(-relative=>1);
1595         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1596     }
1597
1598     my $url = $cgi->url(-path_info=>$add_path);
1599     my $root = (split 'browse', $url)[0];
1600     my $base = (split 'browse', $url)[0] . 'browse';
1601     my $unapi = (split 'browse', $url)[0] . 'unapi';
1602
1603     my $path = $cgi->path_info;
1604     $path =~ s/^\///og;
1605
1606     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1607     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1608
1609     unless ($axis eq 'item-age') {
1610         warn "something's wrong...";
1611         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1612         return undef;
1613     }
1614
1615     my $status = [$cgi->param('status')];
1616     my $cpLoc = [$cgi->param('copyLocation')];
1617     $site ||= $cgi->param('searchOrg') || '-';
1618     $page ||= $cgi->param('startPage') || 1;
1619     $page_size ||= $cgi->param('count') || 10;
1620
1621     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1622     $page_size = 10 if $page_size !~ /^\d+$/;
1623
1624     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1625     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1626
1627     my $recs = $supercat->request(
1628         "open-ils.supercat.new_book_list",
1629         $site,
1630         $page_size,
1631         $page,
1632         $status,
1633         $cpLoc
1634     )->gather(1);
1635
1636     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1637
1638     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1639     print $header.$content;
1640     return Apache2::Const::OK;
1641 }
1642
1643 our %qualifier_ids = (
1644     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1645     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1646     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1647     srw => ''
1648 );
1649
1650 # Our authority search options are currently pretty impoverished;
1651 # just right-truncated string match on a few categories, or by
1652 # ID number
1653 our %nested_auth_qualifier_map = (
1654         eg => {
1655             id          => { index => 'id', title => 'Record number'},
1656             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1657             title       => { index => 'title', title => 'Uniform title'},
1658             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1659             topic       => { index => 'topic', title => 'Topical term'},
1660         },
1661 );
1662
1663 my $base_explain = <<XML;
1664 <explain
1665         id="evergreen-sru-explain-full"
1666         authoritative="true"
1667         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1668         xmlns="http://explain.z3950.org/dtd/2.0/">
1669     <serverInfo transport="http" protocol="SRU" version="1.1">
1670         <host/>
1671         <port/>
1672         <database/>
1673     </serverInfo>
1674
1675     <databaseInfo>
1676         <title primary="true"/>
1677         <description primary="true"/>
1678     </databaseInfo>
1679
1680     <indexInfo>
1681         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1682     </indexInfo>
1683
1684     <schemaInfo>
1685         <schema
1686                 identifier="info:srw/schema/1/marcxml-v1.1"
1687                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1688                 sort="true"
1689                 retrieve="true"
1690                 name="marcxml">
1691             <title>MARC21Slim (marcxml)</title>
1692         </schema>
1693     </schemaInfo>
1694
1695     <configInfo>
1696         <default type="numberOfRecords">10</default>
1697         <default type="contextSet">eg</default>
1698         <default type="index">keyword</default>
1699         <default type="relation">all</default>
1700         <default type="sortSchema">marcxml</default>
1701         <default type="retrieveSchema">marcxml</default>
1702         <setting type="maximumRecords">50</setting>
1703         <supports type="relationModifier">relevant</supports>
1704         <supports type="relationModifier">stem</supports>
1705         <supports type="relationModifier">fuzzy</supports>
1706         <supports type="relationModifier">word</supports>
1707     </configInfo>
1708
1709 </explain>
1710 XML
1711
1712
1713 my $ex_doc;
1714 sub sru_search {
1715     my $cgi = new CGI;
1716
1717     my $req = SRU::Request->newFromCGI( $cgi );
1718     my $resp = SRU::Response->newFromRequest( $req );
1719
1720     # Find the org_unit shortname, if passed as part of the URL
1721     # http://example.com/opac/extras/sru/SHORTNAME
1722     my $url = $cgi->path_info;
1723     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1724
1725     if ( $resp->type eq 'searchRetrieve' ) {
1726
1727         # Older versions of Debian packages returned terms to us double-encoded,
1728         # so we had to forcefully double-decode them a second time with
1729         # an outer decode('utf8', $string) call; this seems to be resolved with
1730         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1731         my $cql_query = decode_utf8($req->query);
1732         my $search_string = decode_utf8($req->cql->toEvergreen);
1733
1734         # Ensure the search string overrides the default site
1735         if ($shortname and $search_string !~ m#site:#) {
1736             $search_string .= " site:$shortname";
1737         }
1738
1739         my $offset = $req->startRecord;
1740         $offset-- if ($offset);
1741         $offset ||= 0;
1742
1743         my $limit = $req->maximumRecords;
1744         $limit ||= 10;
1745
1746         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1747
1748          my $recs = $search->request(
1749             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1750         )->gather(1);
1751
1752         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1753
1754         foreach my $record (@$bre) {
1755             my $marcxml = $record->marc;
1756             # Make the beast conform to a VDX-supported format
1757             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1758             # Trying to implement LIBSOL_852_A format; so much for standards
1759             if ($holdings) {
1760                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1761                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1762
1763                 # Force record leader to 'a' as our data is always UTF8
1764                 # Avoids marc8_to_utf8 from being invoked with horrible results
1765                 # on the off-chance the record leader isn't correct
1766                 my $ldr = $marc->leader;
1767                 substr($ldr, 9, 1, 'a');
1768                 $marc->leader($ldr);
1769
1770                 # Expects the record ID in the 001
1771                 $marc->delete_field($_) for ($marc->field('001'));
1772                 if (!$marc->field('001')) {
1773                     $marc->insert_fields_ordered(
1774                         MARC::Field->new( '001', $record->id )
1775                     );
1776                 }
1777                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1778                 foreach my $cn (keys %$bib_holdings) {
1779                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1780                         $marc->insert_fields_ordered(
1781                             MARC::Field->new(
1782                                 '852', '4', '',
1783                                 a => $cp->{'location'},
1784                                 b => $bib_holdings->{$cn}->{'owning_lib'},
1785                                 c => $cn,
1786                                 d => $cp->{'circlib'},
1787                                 g => $cp->{'barcode'},
1788                                 n => $cp->{'status'},
1789                             )
1790                         );
1791                     }
1792                 }
1793
1794                 # Ensure the data is encoded as UTF8 before we hand it off
1795                 $marcxml = encode_utf8($marc->as_xml_record());
1796                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1797
1798             }
1799             $resp->addRecord(
1800                 SRU::Response::Record->new(
1801                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1802                     recordData => $marcxml,
1803                     recordPosition => ++$offset
1804                 )
1805             );
1806         }
1807
1808         $resp->numberOfRecords($recs->{count});
1809
1810     } elsif ( $resp->type eq 'explain' ) {
1811         return_sru_explain($cgi, $req, $resp, \$ex_doc,
1812             undef,
1813             \%OpenILS::WWW::SuperCat::qualifier_ids
1814         );
1815
1816         $resp->record(
1817             SRU::Response::Record->new(
1818                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1819                 recordData        => $ex_doc
1820             )
1821         );
1822     }
1823
1824     print $cgi->header( -type => 'application/xml' );
1825     print $U->entityize($resp->asXML) . "\n";
1826     return Apache2::Const::OK;
1827 }
1828
1829
1830 {
1831     package CQL::BooleanNode;
1832
1833     sub toEvergreen {
1834         my $self     = shift;
1835         my $left     = $self->left();
1836         my $right    = $self->right();
1837         my $leftStr  = $left->toEvergreen;
1838         my $rightStr = $right->toEvergreen();
1839
1840         my $op =  '||' if uc $self->op() eq 'OR';
1841         $op ||=  '&&';
1842
1843         return  "$leftStr $rightStr";
1844     }
1845
1846     sub toEvergreenAuth {
1847         return toEvergreen(shift);
1848     }
1849
1850     package CQL::TermNode;
1851
1852     sub toEvergreen {
1853         my $self      = shift;
1854         my $qualifier = $self->getQualifier();
1855         my $term      = $self->getTerm();
1856         my $relation  = $self->getRelation();
1857
1858         my $query;
1859         if ( $qualifier ) {
1860             my ($qset, $qname) = split(/\./, $qualifier);
1861
1862             if ( exists($qualifier_map{$qset}{$qname}) ) {
1863                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1864                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
1865             }
1866
1867             my @modifiers = $relation->getModifiers();
1868
1869             my $base = $relation->getBase();
1870             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1871
1872                 my $quote_it = 1;
1873                 foreach my $m ( @modifiers ) {
1874                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1875                         $quote_it = 0;
1876                         last;
1877                     }
1878                 }
1879
1880                 $quote_it = 0 if ( $base eq 'all' );
1881                 $term = maybeQuote($term) if $quote_it;
1882
1883             } else {
1884                 croak( "Evergreen doesn't support the $base relations" );
1885             }
1886
1887
1888         } else {
1889             $qualifier = "kw";
1890         }
1891
1892         return "$qualifier:$term";
1893     }
1894
1895     sub toEvergreenAuth {
1896         my $self      = shift;
1897         my $qualifier = $self->getQualifier();
1898         my $term      = $self->getTerm();
1899         my $relation  = $self->getRelation();
1900
1901         my $query;
1902         if ( $qualifier ) {
1903             my ($qset, $qname) = split(/\./, $qualifier);
1904
1905             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
1906                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
1907                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
1908             }
1909         }
1910         return { qualifier => $qualifier, term => $term };
1911     }
1912 }
1913
1914 my $auth_ex_doc;
1915 sub sru_auth_search {
1916     my $cgi = new CGI;
1917
1918     my $req = SRU::Request->newFromCGI( $cgi );
1919     my $resp = SRU::Response->newFromRequest( $req );
1920
1921     if ( $resp->type eq 'searchRetrieve' ) {
1922         return_auth_response($cgi, $req, $resp);
1923     } elsif ( $resp->type eq 'explain' ) {
1924         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
1925             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
1926             \%OpenILS::WWW::SuperCat::qualifier_ids
1927         );
1928     }
1929
1930     print $cgi->header( -type => 'application/xml' );
1931     print $U->entityize($resp->asXML) . "\n";
1932     return Apache2::Const::OK;
1933 }
1934
1935 sub explain_header {
1936     my $cgi = shift;
1937
1938     my $host = $cgi->virtual_host || $cgi->server_name;
1939
1940     my $add_path = 0;
1941     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1942         my $rel_name = $cgi->url(-relative=>1);
1943         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1944     }
1945     my $base = $cgi->url(-base=>1);
1946     my $url = $cgi->url(-path_info=>$add_path);
1947     $url =~ s/^$base\///o;
1948
1949     my $doc = $parser->parse_string($base_explain);
1950     my $e = $doc->documentElement;
1951     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1952     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1953     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1954
1955     return ($doc, $e);
1956 }
1957
1958 sub return_sru_explain {
1959     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
1960
1961     $index_map ||= \%qualifier_map;
1962     if (!$$explain) {
1963         my ($doc, $e) = explain_header($cgi);
1964         for my $name ( keys %{$index_map} ) {
1965
1966             my $identifier = $qualifier_ids->{ $name };
1967
1968             next unless $identifier;
1969
1970             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
1971             $set_node->setAttribute( identifier => $identifier );
1972             $set_node->setAttribute( name => $name );
1973
1974             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
1975             for my $index ( sort keys %{$index_map->{$name}} ) {
1976                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
1977
1978                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
1979                 $map_node->appendChild( $name_node );
1980
1981                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
1982
1983                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
1984                 $index_node->appendChild( $title_node );
1985                 $index_node->appendChild( $map_node );
1986
1987                 $index_node->setAttribute( id => "$name.$index" );
1988                 $title_node->appendText($index_map->{$name}{$index}{'title'});
1989                 $name_node->setAttribute( set => $name );
1990                 $name_node->appendText($index_map->{$name}{$index}{'index'});
1991
1992                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
1993             }
1994         }
1995
1996         $$explain = $e->toString;
1997     }
1998
1999     $resp->record(
2000         SRU::Response::Record->new(
2001             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2002             recordData      => $$explain
2003         )
2004     );
2005
2006 }
2007
2008 sub return_auth_response {
2009     my ($cgi, $req, $resp) = @_;
2010
2011     my $cql_query = decode_utf8($req->query);
2012     my $search = $req->cql->toEvergreenAuth;
2013
2014     my $qualifier = decode_utf8($search->{qualifier});
2015     my $term = decode_utf8($search->{term});
2016
2017     $log->info("SRU NAF search string [$cql_query] converted to "
2018         . "[$qualifier:$term]\n");
2019
2020     my $page_size = $req->maximumRecords;
2021     $page_size ||= 10;
2022
2023     # startwith deals with pages, so convert startRecord to a page number
2024     my $page = ($req->startRecord / $page_size) || 0;
2025
2026     my $recs;
2027     if ($qualifier eq "id") {
2028         $recs = [ int($term) ];
2029     } else {
2030         $recs = $supercat->request(
2031             "open-ils.supercat.authority.$qualifier.startwith", $term, $page_size, $page
2032         )->gather(1);
2033     }
2034
2035     my $record_position = $req->startRecord;
2036     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2037     foreach my $record (@$recs) {
2038         my $marcxml = $cstore->request(
2039             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2040         )->gather(1)->marc;
2041
2042         $resp->addRecord(
2043             SRU::Response::Record->new(
2044                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2045                 recordData => $marcxml,
2046                 recordPosition => ++$record_position
2047             )
2048         );
2049     }
2050
2051     $resp->numberOfRecords(scalar(@$recs));
2052 }
2053
2054 =head2 get_ou($org_unit)
2055
2056 Returns an aou object for a given actor.org_unit shortname or ID.
2057
2058 =cut
2059
2060 sub get_ou {
2061     my $org = shift || '-';
2062     my $org_unit;
2063
2064     if ($org eq '-') {
2065          $org_unit = $actor->request(
2066             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2067         )->gather(1);
2068     } elsif ($org !~ /^\d+$/o) {
2069          $org_unit = $actor->request(
2070             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2071         )->gather(1);
2072     } else {
2073          $org_unit = $actor->request(
2074             'open-ils.actor.org_unit_list.search' => id => $org
2075         )->gather(1);
2076     }
2077
2078     return $org_unit;
2079 }
2080
2081 1;
2082
2083 # vim: et:ts=4:sw=4