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