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