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