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

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