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