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