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