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