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 $U->entityize($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 $U->entityize($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 $U->entityize($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 $U->entityize($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/x-marcxml+xml"
1202        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1203   <Url type="text/html"
1204        template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1205   <LongName>Search $lib</LongName>
1206   <Query role="example" searchTerms="harry+potter" />
1207   <Developer>Mike Rylander for GPLS/PINES</Developer>
1208   <Contact>feedback\@open-ils.org</Contact>
1209   <SyndicationRight>open</SyndicationRight>
1210   <AdultContent>false</AdultContent>
1211   <Language>en-US</Language>
1212   <OutputEncoding>UTF-8</OutputEncoding>
1213   <InputEncoding>UTF-8</InputEncoding>
1214 </OpenSearchDescription>
1215 OSD
1216     }
1217
1218     return Apache2::Const::OK;
1219 }
1220
1221 sub opensearch_feed {
1222     my $apache = shift;
1223     return Apache2::Const::DECLINED if (-e $apache->filename);
1224
1225     check_child_init();
1226
1227     my $cgi = new CGI;
1228     my $year = (gmtime())[5] + 1900;
1229
1230     my $host = $cgi->virtual_host || $cgi->server_name;
1231
1232     my $add_path = 0;
1233     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1234         my $rel_name = $cgi->url(-relative=>1);
1235         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1236     }
1237
1238     my $url = $cgi->url(-path_info=>$add_path);
1239     my $root = (split 'opensearch', $url)[0];
1240     my $base = (split 'opensearch', $url)[0] . 'opensearch';
1241     my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1242
1243     my $path = $cgi->path_info;
1244     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1245
1246     if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1247
1248         my $version = $1;
1249         my $lib = uc($2);
1250         my $class = $3;
1251
1252         if (!$lib || $lib eq '-') {
1253              $lib = $actor->request(
1254                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1255             )->gather(1)->[0]->shortname;
1256         }
1257
1258         if ($class eq '-') {
1259             $class = 'keyword';
1260         }
1261
1262         return opensearch_osd($version, $lib, $class, $base);
1263     }
1264
1265
1266     my $page = $cgi->param('startPage') || 1;
1267     my $offset = $cgi->param('startIndex') || 1;
1268     my $limit = $cgi->param('count') || 10;
1269
1270     $page = 1 if ($page !~ /^\d+$/);
1271     $offset = 1 if ($offset !~ /^\d+$/);
1272     $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1273
1274     if ($page > 1) {
1275         $offset = ($page - 1) * $limit;
1276     } else {
1277         $offset -= 1;
1278     }
1279
1280     my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1281     (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1282
1283     $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1284     $lang = '' if ($lang eq '*');
1285
1286     $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1287     $sort ||= '';
1288     $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1289     $sortdir ||= '';
1290
1291     $terms .= " " if ($terms && $cgi->param('searchTerms'));
1292     $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1293
1294     $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1295     $class ||= '-';
1296
1297     $type = $cgi->param('responseType') if $cgi->param('responseType');
1298     $type ||= '-';
1299
1300     $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1301     $org ||= '-';
1302
1303
1304     my $kwt = $cgi->param('kw');
1305     my $tit = $cgi->param('ti');
1306     my $aut = $cgi->param('au');
1307     my $sut = $cgi->param('su');
1308     my $set = $cgi->param('se');
1309
1310     $terms .= " " if ($terms && $kwt);
1311     $terms .= "keyword: $kwt" if ($kwt);
1312     $terms .= " " if ($terms && $tit);
1313     $terms .= "title: $tit" if ($tit);
1314     $terms .= " " if ($terms && $aut);
1315     $terms .= "author: $aut" if ($aut);
1316     $terms .= " " if ($terms && $sut);
1317     $terms .= "subject: $sut" if ($sut);
1318     $terms .= " " if ($terms && $set);
1319     $terms .= "series: $set" if ($set);
1320
1321     if ($version eq '1.0') {
1322         $type = 'rss2';
1323     } elsif ($type eq '-') {
1324         $type = 'atom';
1325     }
1326     my $flesh_feed = parse_feed_type($type);
1327
1328     $terms = decode_utf8($terms);
1329     $lang = 'eng' if ($lang eq 'en-US');
1330
1331     $log->debug("OpenSearch terms: $terms");
1332
1333     my $org_unit = get_ou($org);
1334
1335     # Apostrophes break search and get indexed as spaces anyway
1336     my $safe_terms = $terms;
1337     $safe_terms =~ s{'}{ }go;
1338
1339     my $recs = $search->request(
1340         'open-ils.search.biblio.multiclass.query' => {
1341             org_unit    => $org_unit->[0]->id,
1342             offset        => $offset,
1343             limit        => $limit,
1344             sort        => $sort,
1345             sort_dir    => $sortdir,
1346             default_class => $class,
1347             ($lang ?    ( 'language' => $lang    ) : ()),
1348         } => $safe_terms => 1
1349     )->gather(1);
1350
1351     $log->debug("Hits for [$terms]: $recs->{count}");
1352
1353     my $feed = create_record_feed(
1354         'record',
1355         $type,
1356         [ map { $_->[0] } @{$recs->{ids}} ],
1357         $unapi,
1358         $org,
1359         undef,
1360         $flesh_feed
1361     );
1362
1363     $log->debug("Feed created...");
1364
1365     $feed->root($root);
1366     $feed->lib($org);
1367     $feed->search($safe_terms);
1368     $feed->class($class);
1369
1370     $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1371
1372     $feed->creator($host);
1373     $feed->update_ts();
1374
1375     $feed->_create_node(
1376         $feed->{item_xpath},
1377         'http://a9.com/-/spec/opensearch/1.1/',
1378         'totalResults',
1379         $recs->{count},
1380     );
1381
1382     $feed->_create_node(
1383         $feed->{item_xpath},
1384         'http://a9.com/-/spec/opensearch/1.1/',
1385         'startIndex',
1386         $offset + 1,
1387     );
1388
1389     $feed->_create_node(
1390         $feed->{item_xpath},
1391         'http://a9.com/-/spec/opensearch/1.1/',
1392         'itemsPerPage',
1393         $limit,
1394     );
1395
1396     $log->debug("...basic feed data added...");
1397
1398     $feed->link(
1399         next =>
1400         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1401         'application/opensearch+xml'
1402     ) if ($offset + $limit < $recs->{count});
1403
1404     $feed->link(
1405         previous =>
1406         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1407         'application/opensearch+xml'
1408     ) if ($offset);
1409
1410     $feed->link(
1411         self =>
1412         $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1413         'application/opensearch+xml'
1414     );
1415
1416     $feed->link(
1417         alternate =>
1418         $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1419         'application/rss+xml'
1420     );
1421
1422     $feed->link(
1423         atom =>
1424         $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1425         'application/atom+xml'
1426     );
1427
1428     $feed->link(
1429         'html' =>
1430         $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1431         'text/html'
1432     );
1433
1434     $feed->link(
1435         'html-full' =>
1436         $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1437         'text/html'
1438     );
1439
1440     $feed->link( 'unapi-server' => $unapi);
1441
1442     $log->debug("...feed links added...");
1443
1444 #    $feed->link(
1445 #        opac =>
1446 #        $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1447 #            join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1448 #        'text/html'
1449 #    );
1450
1451     #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1452     print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1453
1454     $log->debug("...and feed returned.");
1455
1456     return Apache2::Const::OK;
1457 }
1458
1459 sub create_record_feed {
1460     my $search = shift;
1461     my $type = shift;
1462     my $records = shift;
1463     my $unapi = shift;
1464
1465     my $lib = uc(shift()) || '-';
1466     my $depth = shift;
1467     my $flesh = shift;
1468
1469     my $paging = shift;
1470
1471     my $cgi = new CGI;
1472     my $base = $cgi->url;
1473     my $host = $cgi->virtual_host || $cgi->server_name;
1474
1475     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1476     $year += 1900;
1477     $month += 1;
1478
1479     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1480
1481     my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1482
1483     $type =~ s/(-full|-uris)$//o;
1484
1485     my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1486     $feed->base($base) if ($flesh);
1487     $feed->unapi($unapi) if ($flesh);
1488
1489     $type = 'atom' if ($type eq 'html');
1490     $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1491
1492     #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1493
1494     my $count = 0;
1495     for my $record (@$records) {
1496         next unless($record);
1497
1498         #my $rec = $record->id;
1499         my $rec = $record;
1500
1501         my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1502         $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1503         $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1504         $item_tag .= "/$depth" if (defined($depth));
1505
1506         $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1507
1508         my $xml = $supercat->request(
1509             "open-ils.supercat.$search.$type.retrieve",
1510             $rec
1511         )->gather(1);
1512         next unless $xml;
1513
1514         my $node = $feed->add_item($xml);
1515         next unless $node;
1516
1517         $xml = '';
1518         if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1519             my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1520             while ( !$r->complete ) {
1521                 $xml .= join('', map {$_->content} $r->recv);
1522             }
1523             $xml .= join('', map {$_->content} $r->recv);
1524             $node->add_holdings($xml);
1525         }
1526
1527         $node->id($item_tag);
1528         #$node->update_ts(cleanse_ISO8601($record->edit_date));
1529         $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1530         $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1531         $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1532         $node->link('unapi-id' => $item_tag) if ($flesh);
1533     }
1534
1535     return $feed;
1536 }
1537
1538 sub string_browse {
1539     my $apache = shift;
1540     return Apache2::Const::DECLINED if (-e $apache->filename);
1541
1542     check_child_init();
1543
1544     my $cgi = new CGI;
1545     my $year = (gmtime())[5] + 1900;
1546
1547     my $host = $cgi->virtual_host || $cgi->server_name;
1548
1549     my $add_path = 0;
1550     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1551         my $rel_name = $cgi->url(-relative=>1);
1552         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1553     }
1554
1555     my $url = $cgi->url(-path_info=>$add_path);
1556     my $root = (split 'browse', $url)[0];
1557     my $base = (split 'browse', $url)[0] . 'browse';
1558     my $unapi = (split 'browse', $url)[0] . 'unapi';
1559
1560     my $path = $cgi->path_info;
1561     $path =~ s/^\///og;
1562
1563     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1564     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1565
1566     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1567
1568     my $status = [$cgi->param('status')];
1569     my $cpLoc = [$cgi->param('copyLocation')];
1570     $site ||= $cgi->param('searchOrg');
1571     $page ||= $cgi->param('startPage') || 0;
1572     $page_size ||= $cgi->param('count') || 9;
1573
1574     $page = 0 if ($page !~ /^-?\d+$/);
1575     $page_size = 9 if $page_size !~ /^\d+$/;
1576
1577     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1578     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1579
1580     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1581         warn "something's wrong...";
1582         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1583         return undef;
1584     }
1585
1586     $string = decode_utf8($string);
1587     $string =~ s/\+/ /go;
1588     $string =~ s/'//go;
1589
1590     my $tree;
1591     if ($axis =~ /^authority/) {
1592         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1593
1594         my $method = "open-ils.supercat.authority.browse_center.by_axis";
1595         $method .= ".refs" if $refs;
1596
1597         $tree = $supercat->request(
1598             $method,
1599             $realaxis,
1600             $string,
1601             $page,
1602             $page_size
1603         )->gather(1);
1604     } else {
1605         $tree = $supercat->request(
1606             "open-ils.supercat.$axis.browse",
1607             $string,
1608             $site,
1609             $page_size,
1610             $page,
1611             $status,
1612             $cpLoc
1613         )->gather(1);
1614     }
1615
1616     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1617
1618     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1619     print $header.$content;
1620     return Apache2::Const::OK;
1621 }
1622
1623 sub string_startwith {
1624     my $apache = shift;
1625     return Apache2::Const::DECLINED if (-e $apache->filename);
1626
1627     check_child_init();
1628
1629     my $cgi = new CGI;
1630     my $year = (gmtime())[5] + 1900;
1631
1632     my $host = $cgi->virtual_host || $cgi->server_name;
1633
1634     my $add_path = 0;
1635     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1636         my $rel_name = $cgi->url(-relative=>1);
1637         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1638     }
1639
1640     my $url = $cgi->url(-path_info=>$add_path);
1641     my $root = (split 'startwith', $url)[0];
1642     my $base = (split 'startwith', $url)[0] . 'startwith';
1643     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1644
1645     my $path = $cgi->path_info;
1646     $path =~ s/^\///og;
1647
1648     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1649     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1650
1651     my $status = [$cgi->param('status')];
1652     my $cpLoc = [$cgi->param('copyLocation')];
1653     $site ||= $cgi->param('searchOrg');
1654     $page ||= $cgi->param('startPage') || 0;
1655     $page_size ||= $cgi->param('count') || 9;
1656
1657     $page = 0 if ($page !~ /^-?\d+$/);
1658     $page_size = 9 if $page_size !~ /^\d+$/;
1659
1660     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1661     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1662
1663     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1664         warn "something's wrong...";
1665         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1666         return undef;
1667     }
1668
1669     $string = decode_utf8($string);
1670     $string =~ s/\+/ /go;
1671     $string =~ s/'//go;
1672
1673     my $tree;
1674     if ($axis =~ /^authority/) {
1675         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1676
1677         my $method = "open-ils.supercat.authority.browse_top.by_axis";
1678         $method .= ".refs" if $refs;
1679
1680         $tree = $supercat->request(
1681             $method,
1682             $realaxis,
1683             $string,
1684             $page,
1685             $page_size
1686         )->gather(1);
1687     } else {
1688         $tree = $supercat->request(
1689             "open-ils.supercat.$axis.startwith",
1690             $string,
1691             $site,
1692             $page_size,
1693             $page,
1694             $status,
1695             $cpLoc
1696         )->gather(1);
1697     }
1698
1699     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1700
1701     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1702     print $header.$content;
1703     return Apache2::Const::OK;
1704 }
1705
1706 sub item_age_browse {
1707     my $apache = shift;
1708     return Apache2::Const::DECLINED if (-e $apache->filename);
1709
1710     my $cgi = new CGI;
1711     my $year = (gmtime())[5] + 1900;
1712
1713     my $host = $cgi->virtual_host || $cgi->server_name;
1714
1715     my $add_path = 0;
1716     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1717         my $rel_name = $cgi->url(-relative=>1);
1718         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1719     }
1720
1721     my $url = $cgi->url(-path_info=>$add_path);
1722     my $root = (split 'browse', $url)[0];
1723     my $base = (split 'browse', $url)[0] . 'browse';
1724     my $unapi = (split 'browse', $url)[0] . 'unapi';
1725
1726     my $path = $cgi->path_info;
1727     $path =~ s/^\///og;
1728
1729     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1730     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1731
1732     unless ($axis eq 'item-age') {
1733         warn "something's wrong...";
1734         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1735         return undef;
1736     }
1737
1738     my $status = [$cgi->param('status')];
1739     my $cpLoc = [$cgi->param('copyLocation')];
1740     $site ||= $cgi->param('searchOrg') || '-';
1741     $page ||= $cgi->param('startPage') || 1;
1742     $page_size ||= $cgi->param('count') || 10;
1743
1744     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1745     $page_size = 10 if $page_size !~ /^\d+$/;
1746
1747     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1748     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1749
1750     my $recs = $supercat->request(
1751         "open-ils.supercat.new_book_list",
1752         $site,
1753         $page_size,
1754         $page,
1755         $status,
1756         $cpLoc
1757     )->gather(1);
1758
1759     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1760
1761     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1762     print $header.$content;
1763     return Apache2::Const::OK;
1764 }
1765
1766 our %qualifier_ids = (
1767     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1768     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1769     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1770     srw => ''
1771 );
1772
1773 # Our authority search options are currently pretty impoverished;
1774 # just right-truncated string match on a few categories, or by
1775 # ID number
1776 our %nested_auth_qualifier_map = (
1777         eg => {
1778             id          => { index => 'id', title => 'Record number'},
1779             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1780             title       => { index => 'title', title => 'Uniform title'},
1781             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1782             topic       => { index => 'topic', title => 'Topical term'},
1783         },
1784 );
1785
1786 my $base_explain = <<XML;
1787 <explain
1788         id="evergreen-sru-explain-full"
1789         authoritative="true"
1790         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1791         xmlns="http://explain.z3950.org/dtd/2.0/">
1792     <serverInfo transport="http" protocol="SRU" version="1.1">
1793         <host/>
1794         <port/>
1795         <database/>
1796     </serverInfo>
1797
1798     <databaseInfo>
1799         <title primary="true"/>
1800         <description primary="true"/>
1801     </databaseInfo>
1802
1803     <indexInfo>
1804         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1805     </indexInfo>
1806
1807     <schemaInfo>
1808         <schema
1809                 identifier="info:srw/schema/1/marcxml-v1.1"
1810                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1811                 sort="true"
1812                 retrieve="true"
1813                 name="marcxml">
1814             <title>MARC21Slim (marcxml)</title>
1815         </schema>
1816     </schemaInfo>
1817
1818     <configInfo>
1819         <default type="numberOfRecords">10</default>
1820         <default type="contextSet">eg</default>
1821         <default type="index">keyword</default>
1822         <default type="relation">all</default>
1823         <default type="sortSchema">marcxml</default>
1824         <default type="retrieveSchema">marcxml</default>
1825         <setting type="maximumRecords">50</setting>
1826         <supports type="relationModifier">relevant</supports>
1827         <supports type="relationModifier">stem</supports>
1828         <supports type="relationModifier">fuzzy</supports>
1829         <supports type="relationModifier">word</supports>
1830     </configInfo>
1831
1832 </explain>
1833 XML
1834
1835
1836 my $ex_doc;
1837 sub sru_search {
1838     my $cgi = new CGI;
1839
1840     check_child_init();
1841
1842     my $req = SRU::Request->newFromCGI( $cgi );
1843     my $resp = SRU::Response->newFromRequest( $req );
1844
1845     # Find the org_unit shortname, if passed as part of the URL
1846     # http://example.com/opac/extras/sru/SHORTNAME
1847     my $url = $cgi->path_info;
1848     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1849
1850     if ( $resp->type eq 'searchRetrieve' ) {
1851
1852         # Older versions of Debian packages returned terms to us double-encoded,
1853         # so we had to forcefully double-decode them a second time with
1854         # an outer decode('utf8', $string) call; this seems to be resolved with
1855         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1856         my $cql_query = decode_utf8($req->query);
1857         my $search_string = decode_utf8($req->cql->toEvergreen);
1858
1859         # Ensure the search string overrides the default site
1860         if ($shortname and $search_string !~ m#site:#) {
1861             $search_string .= " site:$shortname";
1862         }
1863
1864         my $offset = $req->startRecord;
1865         $offset-- if ($offset);
1866         $offset ||= 0;
1867
1868         my $limit = $req->maximumRecords;
1869         $limit ||= 10;
1870
1871         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1872
1873          my $recs = $search->request(
1874             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1875         )->gather(1);
1876
1877         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1878
1879         foreach my $record (@$bre) {
1880             my $marcxml = $record->marc;
1881             # Make the beast conform to a VDX-supported format
1882             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1883             # Trying to implement LIBSOL_852_A format; so much for standards
1884             if ($holdings) {
1885                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1886                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1887
1888                 # Force record leader to 'a' as our data is always UTF8
1889                 # Avoids marc8_to_utf8 from being invoked with horrible results
1890                 # on the off-chance the record leader isn't correct
1891                 my $ldr = $marc->leader;
1892                 substr($ldr, 9, 1, 'a');
1893                 $marc->leader($ldr);
1894
1895                 # Expects the record ID in the 001
1896                 $marc->delete_field($_) for ($marc->field('001'));
1897                 if (!$marc->field('001')) {
1898                     $marc->insert_fields_ordered(
1899                         MARC::Field->new( '001', $record->id )
1900                     );
1901                 }
1902                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1903                 foreach my $cn (keys %$bib_holdings) {
1904                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1905                         $marc->insert_fields_ordered(
1906                             MARC::Field->new(
1907                                 '852', '4', '',
1908                                 a => $cp->{'location'},
1909                                 b => $bib_holdings->{$cn}->{'owning_lib'},
1910                                 c => $cn,
1911                                 d => $cp->{'circlib'},
1912                                 g => $cp->{'barcode'},
1913                                 n => $cp->{'status'},
1914                             )
1915                         );
1916                     }
1917                 }
1918
1919                 # Ensure the data is encoded as UTF8 before we hand it off
1920                 $marcxml = encode_utf8($marc->as_xml_record());
1921                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1922
1923             }
1924             $resp->addRecord(
1925                 SRU::Response::Record->new(
1926                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1927                     recordData => $marcxml,
1928                     recordPosition => ++$offset
1929                 )
1930             );
1931         }
1932
1933         $resp->numberOfRecords($recs->{count});
1934
1935     } elsif ( $resp->type eq 'explain' ) {
1936         return_sru_explain($cgi, $req, $resp, \$ex_doc,
1937             undef,
1938             \%OpenILS::WWW::SuperCat::qualifier_ids
1939         );
1940
1941         $resp->record(
1942             SRU::Response::Record->new(
1943                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1944                 recordData        => $ex_doc
1945             )
1946         );
1947     }
1948
1949     print $cgi->header( -type => 'application/xml' );
1950     print $U->entityize($resp->asXML) . "\n";
1951     return Apache2::Const::OK;
1952 }
1953
1954
1955 {
1956     package CQL::BooleanNode;
1957
1958     sub toEvergreen {
1959         my $self     = shift;
1960         my $left     = $self->left();
1961         my $right    = $self->right();
1962         my $leftStr  = $left->toEvergreen;
1963         my $rightStr = $right->toEvergreen();
1964
1965         my $op =  '||' if uc $self->op() eq 'OR';
1966         $op ||=  '&&';
1967
1968         return  "$leftStr $rightStr";
1969     }
1970
1971     sub toEvergreenAuth {
1972         return toEvergreen(shift);
1973     }
1974
1975     package CQL::TermNode;
1976
1977     sub toEvergreen {
1978         my $self      = shift;
1979         my $qualifier = $self->getQualifier();
1980         my $term      = $self->getTerm();
1981         my $relation  = $self->getRelation();
1982
1983         my $query;
1984         if ( $qualifier ) {
1985             my ($qset, $qname) = split(/\./, $qualifier);
1986
1987             # Per http://www.loc.gov/standards/sru/specs/cql.html
1988             # "All parts of CQL are case insensitive [...] If any case insensitive
1989             # part of CQL is specified with both upper and lower case, it is for
1990             # aesthetic purposes only."
1991
1992             # So fold the qualifier and relation to lower case
1993             $qset = lc($qset);
1994             $qname = lc($qname);
1995
1996             if ( exists($qualifier_map{$qset}{$qname}) ) {
1997                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
1998                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
1999             }
2000
2001             my @modifiers = $relation->getModifiers();
2002
2003             my $base = $relation->getBase();
2004             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2005
2006                 my $quote_it = 1;
2007                 foreach my $m ( @modifiers ) {
2008                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2009                         $quote_it = 0;
2010                         last;
2011                     }
2012                 }
2013
2014                 $quote_it = 0 if ( $base eq 'all' );
2015                 $term = maybeQuote($term) if $quote_it;
2016
2017             } else {
2018                 croak( "Evergreen doesn't support the $base relations" );
2019             }
2020
2021
2022         } else {
2023             $qualifier = "kw";
2024         }
2025
2026         return "$qualifier:$term";
2027     }
2028
2029     sub toEvergreenAuth {
2030         my $self      = shift;
2031         my $qualifier = $self->getQualifier();
2032         my $term      = $self->getTerm();
2033         my $relation  = $self->getRelation();
2034
2035         my $query;
2036         if ( $qualifier ) {
2037             my ($qset, $qname) = split(/\./, $qualifier);
2038
2039             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2040                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2041                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2042             }
2043         }
2044         return { qualifier => $qualifier, term => $term };
2045     }
2046 }
2047
2048 my $auth_ex_doc;
2049 sub sru_auth_search {
2050     my $cgi = new CGI;
2051
2052     check_child_init();
2053
2054     my $req = SRU::Request->newFromCGI( $cgi );
2055     my $resp = SRU::Response->newFromRequest( $req );
2056
2057     if ( $resp->type eq 'searchRetrieve' ) {
2058         return_auth_response($cgi, $req, $resp);
2059     } elsif ( $resp->type eq 'explain' ) {
2060         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2061             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2062             \%OpenILS::WWW::SuperCat::qualifier_ids
2063         );
2064     }
2065
2066     print $cgi->header( -type => 'application/xml' );
2067     print $U->entityize($resp->asXML) . "\n";
2068     return Apache2::Const::OK;
2069 }
2070
2071 sub explain_header {
2072     my $cgi = shift;
2073
2074     my $host = $cgi->virtual_host || $cgi->server_name;
2075
2076     my $add_path = 0;
2077     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2078         my $rel_name = $cgi->url(-relative=>1);
2079         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2080     }
2081     my $base = $cgi->url(-base=>1);
2082     my $url = $cgi->url(-path_info=>$add_path);
2083     $url =~ s/^$base\///o;
2084
2085     my $doc = $parser->parse_string($base_explain);
2086     my $e = $doc->documentElement;
2087     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2088     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2089     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2090
2091     return ($doc, $e);
2092 }
2093
2094 sub return_sru_explain {
2095     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2096
2097     $index_map ||= \%qualifier_map;
2098     if (!$$explain) {
2099         my ($doc, $e) = explain_header($cgi);
2100         for my $name ( keys %{$index_map} ) {
2101
2102             my $identifier = $qualifier_ids->{ $name };
2103
2104             next unless $identifier;
2105
2106             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2107             $set_node->setAttribute( identifier => $identifier );
2108             $set_node->setAttribute( name => $name );
2109
2110             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2111             for my $index ( sort keys %{$index_map->{$name}} ) {
2112                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2113
2114                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2115                 $map_node->appendChild( $name_node );
2116
2117                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2118
2119                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2120                 $index_node->appendChild( $title_node );
2121                 $index_node->appendChild( $map_node );
2122
2123                 $index_node->setAttribute( id => "$name.$index" );
2124                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2125                 $name_node->setAttribute( set => $name );
2126                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2127
2128                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2129             }
2130         }
2131
2132         $$explain = $e->toString;
2133     }
2134
2135     $resp->record(
2136         SRU::Response::Record->new(
2137             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2138             recordData      => $$explain
2139         )
2140     );
2141
2142 }
2143
2144 sub return_auth_response {
2145     my ($cgi, $req, $resp) = @_;
2146
2147     my $cql_query = decode_utf8($req->query);
2148     my $search = $req->cql->toEvergreenAuth;
2149
2150     my $qualifier = decode_utf8($search->{qualifier});
2151     my $term = decode_utf8($search->{term});
2152
2153     $log->info("SRU NAF search string [$cql_query] converted to "
2154         . "[$qualifier:$term]\n");
2155
2156     my $page_size = $req->maximumRecords;
2157     $page_size ||= 10;
2158
2159     # startwith deals with pages, so convert startRecord to a page number
2160     my $page = ($req->startRecord / $page_size) || 0;
2161
2162     my $recs;
2163     if ($qualifier eq "id") {
2164         $recs = [ int($term) ];
2165     } else {
2166         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2167
2168         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2169         $method .= ".refs" if $refs;
2170
2171         $recs = $supercat->request(
2172             $method,
2173             $realaxis,
2174             $term,
2175             $page,
2176             $page_size
2177         )->gather(1);
2178     }
2179
2180     my $record_position = $req->startRecord;
2181     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2182     foreach my $record (@$recs) {
2183         my $marcxml = $cstore->request(
2184             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2185         )->gather(1)->marc;
2186
2187         $resp->addRecord(
2188             SRU::Response::Record->new(
2189                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2190                 recordData => $marcxml,
2191                 recordPosition => ++$record_position
2192             )
2193         );
2194     }
2195
2196     $resp->numberOfRecords(scalar(@$recs));
2197 }
2198
2199 =head2 get_ou($org_unit)
2200
2201 Returns an aou object for a given actor.org_unit shortname or ID.
2202
2203 =cut
2204
2205 sub get_ou {
2206     my $org = shift || '-';
2207     my $org_unit;
2208
2209     if ($org eq '-') {
2210          $org_unit = $actor->request(
2211             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2212         )->gather(1);
2213     } elsif ($org !~ /^\d+$/o) {
2214          $org_unit = $actor->request(
2215             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2216         )->gather(1);
2217     } else {
2218          $org_unit = $actor->request(
2219             'open-ils.actor.org_unit_list.search' => id => $org
2220         )->gather(1);
2221     }
2222
2223     return $org_unit;
2224 }
2225
2226 1;
2227
2228 # vim: et:ts=4:sw=4