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