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