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