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