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