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