Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat.pm

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