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) = split '/', $path;
1615     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
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
1625     $page = 0 if ($page !~ /^-?\d+$/);
1626     $page_size = 9 if $page_size !~ /^\d+$/;
1627
1628     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1629     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1630
1631     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1632         warn "something's wrong...";
1633         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1634         return undef;
1635     }
1636
1637     $string = decode_utf8($string);
1638     $string =~ s/\+/ /go;
1639     $string =~ s/'//go;
1640
1641     my $tree;
1642     if ($axis =~ /^authority/) {
1643         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1644
1645         my $method = "open-ils.supercat.authority.browse_center.by_axis";
1646         $method .= ".refs" if $refs;
1647
1648         $tree = $supercat->request(
1649             $method,
1650             $realaxis,
1651             $string,
1652             $page,
1653             $page_size
1654         )->gather(1);
1655     } else {
1656         $tree = $supercat->request(
1657             "open-ils.supercat.$axis.browse",
1658             $string,
1659             $site,
1660             $page_size,
1661             $page,
1662             $status,
1663             $cpLoc
1664         )->gather(1);
1665     }
1666
1667     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1668
1669     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1670     print $header.$content;
1671     return Apache2::Const::OK;
1672 }
1673
1674 sub string_startwith {
1675     my $apache = shift;
1676     return Apache2::Const::DECLINED if (-e $apache->filename);
1677
1678     check_child_init();
1679
1680     my $cgi = new CGI;
1681     my $year = (gmtime())[5] + 1900;
1682
1683     my $host = $cgi->virtual_host || $cgi->server_name;
1684
1685     my $add_path = 0;
1686     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1687         my $rel_name = $cgi->url(-relative=>1);
1688         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1689     }
1690
1691     my $url = $cgi->url(-path_info=>$add_path);
1692     my $root = (split 'startwith', $url)[0];
1693     my $base = (split 'startwith', $url)[0] . 'startwith';
1694     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1695
1696     my $path = $cgi->path_info;
1697     $path =~ s/^\///og;
1698
1699     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1700     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1701
1702     my $status = [$cgi->param('status')];
1703     my $cpLoc = [$cgi->param('copyLocation')];
1704     $site ||= $cgi->param('searchOrg');
1705     $page ||= $cgi->param('startPage') || 0;
1706     $page_size ||= $cgi->param('count') || 9;
1707
1708     $page = 0 if ($page !~ /^-?\d+$/);
1709     $page_size = 9 if $page_size !~ /^\d+$/;
1710
1711     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1712     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1713
1714     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1715         warn "something's wrong...";
1716         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1717         return undef;
1718     }
1719
1720     $string = decode_utf8($string);
1721     $string =~ s/\+/ /go;
1722     $string =~ s/'//go;
1723
1724     my $tree;
1725     if ($axis =~ /^authority/) {
1726         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1727
1728         my $method = "open-ils.supercat.authority.browse_top.by_axis";
1729         $method .= ".refs" if $refs;
1730
1731         $tree = $supercat->request(
1732             $method,
1733             $realaxis,
1734             $string,
1735             $page,
1736             $page_size
1737         )->gather(1);
1738     } else {
1739         $tree = $supercat->request(
1740             "open-ils.supercat.$axis.startwith",
1741             $string,
1742             $site,
1743             $page_size,
1744             $page,
1745             $status,
1746             $cpLoc
1747         )->gather(1);
1748     }
1749
1750     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1751
1752     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1753     print $header.$content;
1754     return Apache2::Const::OK;
1755 }
1756
1757 sub item_age_browse {
1758     my $apache = shift;
1759     return Apache2::Const::DECLINED if (-e $apache->filename);
1760
1761     check_child_init();
1762
1763     my $cgi = new CGI;
1764     my $year = (gmtime())[5] + 1900;
1765
1766     my $host = $cgi->virtual_host || $cgi->server_name;
1767
1768     my $add_path = 0;
1769     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1770         my $rel_name = $cgi->url(-relative=>1);
1771         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1772     }
1773
1774     my $url = $cgi->url(-path_info=>$add_path);
1775     my $root = (split 'browse', $url)[0];
1776     my $base = (split 'browse', $url)[0] . 'browse';
1777     my $unapi = (split 'browse', $url)[0] . 'unapi';
1778
1779     my $path = $cgi->path_info;
1780     $path =~ s/^\///og;
1781
1782     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1783     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1784
1785     unless ($axis eq 'item-age') {
1786         warn "something's wrong...";
1787         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1788         return undef;
1789     }
1790
1791     my $status = [$cgi->param('status')];
1792     my $cpLoc = [$cgi->param('copyLocation')];
1793     $site ||= $cgi->param('searchOrg') || '-';
1794     $page ||= $cgi->param('startPage') || 1;
1795     $page_size ||= $cgi->param('count') || 10;
1796
1797     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1798     $page_size = 10 if $page_size !~ /^\d+$/;
1799
1800     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1801     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1802
1803     my $recs = $supercat->request(
1804         "open-ils.supercat.new_book_list",
1805         $site,
1806         $page_size,
1807         $page,
1808         $status,
1809         $cpLoc
1810     )->gather(1);
1811
1812     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1813
1814     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1815     print $header.$content;
1816     return Apache2::Const::OK;
1817 }
1818
1819 our %qualifier_ids = (
1820     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1821     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1822     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1823     srw => ''
1824 );
1825
1826 # Our authority search options are currently pretty impoverished;
1827 # just right-truncated string match on a few categories, or by
1828 # ID number
1829 our %nested_auth_qualifier_map = (
1830         eg => {
1831             id          => { index => 'id', title => 'Record number'},
1832             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1833             title       => { index => 'title', title => 'Uniform title'},
1834             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1835             topic       => { index => 'topic', title => 'Topical term'},
1836         },
1837 );
1838
1839 my $base_explain = <<XML;
1840 <explain
1841         id="evergreen-sru-explain-full"
1842         authoritative="true"
1843         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1844         xmlns="http://explain.z3950.org/dtd/2.0/">
1845     <serverInfo transport="http" protocol="SRU" version="1.1">
1846         <host/>
1847         <port/>
1848         <database/>
1849     </serverInfo>
1850
1851     <databaseInfo>
1852         <title primary="true"/>
1853         <description primary="true"/>
1854     </databaseInfo>
1855
1856     <indexInfo>
1857         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1858     </indexInfo>
1859
1860     <schemaInfo>
1861         <schema
1862                 identifier="info:srw/schema/1/marcxml-v1.1"
1863                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1864                 sort="true"
1865                 retrieve="true"
1866                 name="marcxml">
1867             <title>MARC21Slim (marcxml)</title>
1868         </schema>
1869     </schemaInfo>
1870
1871     <configInfo>
1872         <default type="numberOfRecords">10</default>
1873         <default type="contextSet">eg</default>
1874         <default type="index">keyword</default>
1875         <default type="relation">all</default>
1876         <default type="sortSchema">marcxml</default>
1877         <default type="retrieveSchema">marcxml</default>
1878         <setting type="maximumRecords">50</setting>
1879         <supports type="relationModifier">relevant</supports>
1880         <supports type="relationModifier">stem</supports>
1881         <supports type="relationModifier">fuzzy</supports>
1882         <supports type="relationModifier">word</supports>
1883     </configInfo>
1884
1885 </explain>
1886 XML
1887
1888
1889 my $ex_doc;
1890 sub sru_search {
1891     my $cgi = new CGI;
1892
1893     check_child_init();
1894
1895     my $req = SRU::Request->newFromCGI( $cgi );
1896     my $resp = SRU::Response->newFromRequest( $req );
1897
1898     # Find the org_unit shortname, if passed as part of the URL
1899     # http://example.com/opac/extras/sru/SHORTNAME
1900     my $url = $cgi->path_info;
1901     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1902
1903     if ( $resp->type eq 'searchRetrieve' ) {
1904
1905         # Older versions of Debian packages returned terms to us double-encoded,
1906         # so we had to forcefully double-decode them a second time with
1907         # an outer decode('utf8', $string) call; this seems to be resolved with
1908         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1909         my $cql_query = decode_utf8($req->query);
1910         my $search_string = decode_utf8($req->cql->toEvergreen);
1911
1912         # Ensure the search string overrides the default site
1913         if ($shortname and $search_string !~ m#site:#) {
1914             $search_string .= " site:$shortname";
1915         }
1916
1917         my $offset = $req->startRecord;
1918         $offset-- if ($offset);
1919         $offset ||= 0;
1920
1921         my $limit = $req->maximumRecords;
1922         $limit ||= 10;
1923
1924         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1925
1926          my $recs = $search->request(
1927             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1928         )->gather(1);
1929
1930         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1931
1932         foreach my $record (@$bre) {
1933             my $marcxml = $record->marc;
1934             # Make the beast conform to a VDX-supported format
1935             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1936             # Trying to implement LIBSOL_852_A format; so much for standards
1937             if ($holdings) {
1938                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1939                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1940
1941                 # Force record leader to 'a' as our data is always UTF8
1942                 # Avoids marc8_to_utf8 from being invoked with horrible results
1943                 # on the off-chance the record leader isn't correct
1944                 my $ldr = $marc->leader;
1945                 substr($ldr, 9, 1, 'a');
1946                 $marc->leader($ldr);
1947
1948                 # Expects the record ID in the 001
1949                 $marc->delete_field($_) for ($marc->field('001'));
1950                 if (!$marc->field('001')) {
1951                     $marc->insert_fields_ordered(
1952                         MARC::Field->new( '001', $record->id )
1953                     );
1954                 }
1955                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1956                 foreach my $cn (keys %$bib_holdings) {
1957                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1958                         $marc->insert_fields_ordered(
1959                             MARC::Field->new(
1960                                 '852', '4', '',
1961                                 a => $cp->{'location'},
1962                                 b => $bib_holdings->{$cn}->{'owning_lib'},
1963                                 c => $cn,
1964                                 d => $cp->{'circlib'},
1965                                 g => $cp->{'barcode'},
1966                                 n => $cp->{'status'},
1967                             )
1968                         );
1969                     }
1970                 }
1971
1972                 # Ensure the data is encoded as UTF8 before we hand it off
1973                 $marcxml = encode_utf8($marc->as_xml_record());
1974                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1975
1976             }
1977             $resp->addRecord(
1978                 SRU::Response::Record->new(
1979                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1980                     recordData => $marcxml,
1981                     recordPosition => ++$offset
1982                 )
1983             );
1984         }
1985
1986         $resp->numberOfRecords($recs->{count});
1987
1988     } elsif ( $resp->type eq 'explain' ) {
1989         return_sru_explain($cgi, $req, $resp, \$ex_doc,
1990             undef,
1991             \%OpenILS::WWW::SuperCat::qualifier_ids
1992         );
1993
1994         $resp->record(
1995             SRU::Response::Record->new(
1996                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1997                 recordData        => $ex_doc
1998             )
1999         );
2000     }
2001
2002     print $cgi->header( -type => 'application/xml' );
2003     print $U->entityize($resp->asXML) . "\n";
2004     return Apache2::Const::OK;
2005 }
2006
2007
2008 {
2009     package CQL::BooleanNode;
2010
2011     sub toEvergreen {
2012         my $self     = shift;
2013         my $left     = $self->left();
2014         my $right    = $self->right();
2015         my $leftStr  = $left->toEvergreen;
2016         my $rightStr = $right->toEvergreen();
2017
2018         my $op =  '||' if uc $self->op() eq 'OR';
2019         $op ||=  '&&';
2020
2021         return  "$leftStr $rightStr";
2022     }
2023
2024     sub toEvergreenAuth {
2025         return toEvergreen(shift);
2026     }
2027
2028     package CQL::TermNode;
2029
2030     sub toEvergreen {
2031         my $self      = shift;
2032         my $qualifier = $self->getQualifier();
2033         my $term      = $self->getTerm();
2034         my $relation  = $self->getRelation();
2035
2036         my $query;
2037         if ( $qualifier ) {
2038             my ($qset, $qname) = split(/\./, $qualifier);
2039
2040             # Per http://www.loc.gov/standards/sru/specs/cql.html
2041             # "All parts of CQL are case insensitive [...] If any case insensitive
2042             # part of CQL is specified with both upper and lower case, it is for
2043             # aesthetic purposes only."
2044
2045             # So fold the qualifier and relation to lower case
2046             $qset = lc($qset);
2047             $qname = lc($qname);
2048
2049             if ( exists($qualifier_map{$qset}{$qname}) ) {
2050                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2051                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
2052             }
2053
2054             my @modifiers = $relation->getModifiers();
2055
2056             my $base = $relation->getBase();
2057             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2058
2059                 my $quote_it = 1;
2060                 foreach my $m ( @modifiers ) {
2061                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2062                         $quote_it = 0;
2063                         last;
2064                     }
2065                 }
2066
2067                 $quote_it = 0 if ( $base eq 'all' );
2068                 $term = maybeQuote($term) if $quote_it;
2069
2070             } else {
2071                 croak( "Evergreen doesn't support the $base relations" );
2072             }
2073
2074
2075         } else {
2076             $qualifier = "kw";
2077         }
2078
2079         return "$qualifier:$term";
2080     }
2081
2082     sub toEvergreenAuth {
2083         my $self      = shift;
2084         my $qualifier = $self->getQualifier();
2085         my $term      = $self->getTerm();
2086         my $relation  = $self->getRelation();
2087
2088         my $query;
2089         if ( $qualifier ) {
2090             my ($qset, $qname) = split(/\./, $qualifier);
2091
2092             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2093                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2094                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2095             }
2096         }
2097         return { qualifier => $qualifier, term => $term };
2098     }
2099 }
2100
2101 my $auth_ex_doc;
2102 sub sru_auth_search {
2103     my $cgi = new CGI;
2104
2105     check_child_init();
2106
2107     my $req = SRU::Request->newFromCGI( $cgi );
2108     my $resp = SRU::Response->newFromRequest( $req );
2109
2110     if ( $resp->type eq 'searchRetrieve' ) {
2111         return_auth_response($cgi, $req, $resp);
2112     } elsif ( $resp->type eq 'explain' ) {
2113         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2114             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2115             \%OpenILS::WWW::SuperCat::qualifier_ids
2116         );
2117     }
2118
2119     print $cgi->header( -type => 'application/xml' );
2120     print $U->entityize($resp->asXML) . "\n";
2121     return Apache2::Const::OK;
2122 }
2123
2124 sub explain_header {
2125     my $cgi = shift;
2126
2127     my $host = $cgi->virtual_host || $cgi->server_name;
2128
2129     my $add_path = 0;
2130     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2131         my $rel_name = $cgi->url(-relative=>1);
2132         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2133     }
2134     my $base = $cgi->url(-base=>1);
2135     my $url = $cgi->url(-path_info=>$add_path);
2136     $url =~ s/^$base\///o;
2137
2138     my $doc = $parser->parse_string($base_explain);
2139     my $e = $doc->documentElement;
2140     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2141     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2142     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2143
2144     return ($doc, $e);
2145 }
2146
2147 sub return_sru_explain {
2148     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2149
2150     $index_map ||= \%qualifier_map;
2151     if (!$$explain) {
2152         my ($doc, $e) = explain_header($cgi);
2153         for my $name ( keys %{$index_map} ) {
2154
2155             my $identifier = $qualifier_ids->{ $name };
2156
2157             next unless $identifier;
2158
2159             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2160             $set_node->setAttribute( identifier => $identifier );
2161             $set_node->setAttribute( name => $name );
2162
2163             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2164             for my $index ( sort keys %{$index_map->{$name}} ) {
2165                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2166
2167                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2168                 $map_node->appendChild( $name_node );
2169
2170                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2171
2172                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2173                 $index_node->appendChild( $title_node );
2174                 $index_node->appendChild( $map_node );
2175
2176                 $index_node->setAttribute( id => "$name.$index" );
2177                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2178                 $name_node->setAttribute( set => $name );
2179                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2180
2181                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2182             }
2183         }
2184
2185         $$explain = $e->toString;
2186     }
2187
2188     $resp->record(
2189         SRU::Response::Record->new(
2190             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2191             recordData      => $$explain
2192         )
2193     );
2194
2195 }
2196
2197 sub return_auth_response {
2198     my ($cgi, $req, $resp) = @_;
2199
2200     my $cql_query = decode_utf8($req->query);
2201     my $search = $req->cql->toEvergreenAuth;
2202
2203     my $qualifier = decode_utf8($search->{qualifier});
2204     my $term = decode_utf8($search->{term});
2205
2206     $log->info("SRU NAF search string [$cql_query] converted to "
2207         . "[$qualifier:$term]\n");
2208
2209     my $page_size = $req->maximumRecords;
2210     $page_size ||= 10;
2211
2212     # startwith deals with pages, so convert startRecord to a page number
2213     my $page = ($req->startRecord / $page_size) || 0;
2214
2215     my $recs;
2216     if ($qualifier eq "id") {
2217         $recs = [ int($term) ];
2218     } else {
2219         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2220
2221         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2222         $method .= ".refs" if $refs;
2223
2224         $recs = $supercat->request(
2225             $method,
2226             $realaxis,
2227             $term,
2228             $page,
2229             $page_size
2230         )->gather(1);
2231     }
2232
2233     my $record_position = $req->startRecord;
2234     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2235     foreach my $record (@$recs) {
2236         my $marcxml = $cstore->request(
2237             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2238         )->gather(1)->marc;
2239
2240         $resp->addRecord(
2241             SRU::Response::Record->new(
2242                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2243                 recordData => $marcxml,
2244                 recordPosition => ++$record_position
2245             )
2246         );
2247     }
2248
2249     $resp->numberOfRecords(scalar(@$recs));
2250 }
2251
2252 =head2 get_ou($org_unit)
2253
2254 Returns an aou object for a given actor.org_unit shortname or ID.
2255
2256 =cut
2257
2258 sub get_ou {
2259     my $org = shift || '-';
2260     my $org_unit;
2261
2262     if ($org eq '-') {
2263          $org_unit = $actor->request(
2264             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2265         )->gather(1);
2266     } elsif ($org !~ /^\d+$/o) {
2267          $org_unit = $actor->request(
2268             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2269         )->gather(1);
2270     } else {
2271          $org_unit = $actor->request(
2272             'open-ils.actor.org_unit_list.search' => id => $org
2273         )->gather(1);
2274     }
2275
2276     return $org_unit;
2277 }
2278
2279 1;
2280
2281 # vim: et:ts=4:sw=4