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