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                 $marcxml = $marc->as_xml_record();
1973                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1974
1975             }
1976             $resp->addRecord(
1977                 SRU::Response::Record->new(
1978                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1979                     recordData => $marcxml,
1980                     recordPosition => ++$offset
1981                 )
1982             );
1983         }
1984
1985         $resp->numberOfRecords($recs->{count});
1986
1987     } elsif ( $resp->type eq 'explain' ) {
1988         return_sru_explain($cgi, $req, $resp, \$ex_doc,
1989             undef,
1990             \%OpenILS::WWW::SuperCat::qualifier_ids
1991         );
1992
1993         $resp->record(
1994             SRU::Response::Record->new(
1995                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1996                 recordData        => $ex_doc
1997             )
1998         );
1999     }
2000
2001     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2002     print $U->entityize($resp->asXML) . "\n";
2003     return Apache2::Const::OK;
2004 }
2005
2006
2007 {
2008     package CQL::BooleanNode;
2009
2010     sub toEvergreen {
2011         my $self     = shift;
2012         my $left     = $self->left();
2013         my $right    = $self->right();
2014         my $leftStr  = $left->toEvergreen;
2015         my $rightStr = $right->toEvergreen();
2016
2017         my $op =  '||' if uc $self->op() eq 'OR';
2018         $op ||=  '&&';
2019
2020         return  "$leftStr $rightStr";
2021     }
2022
2023     sub toEvergreenAuth {
2024         return toEvergreen(shift);
2025     }
2026
2027     package CQL::TermNode;
2028
2029     sub toEvergreen {
2030         my $self      = shift;
2031         my $qualifier = $self->getQualifier();
2032         my $term      = $self->getTerm();
2033         my $relation  = $self->getRelation();
2034
2035         my $query;
2036         if ( $qualifier ) {
2037             my ($qset, $qname) = split(/\./, $qualifier);
2038
2039             # Per http://www.loc.gov/standards/sru/specs/cql.html
2040             # "All parts of CQL are case insensitive [...] If any case insensitive
2041             # part of CQL is specified with both upper and lower case, it is for
2042             # aesthetic purposes only."
2043
2044             # So fold the qualifier and relation to lower case
2045             $qset = lc($qset);
2046             $qname = lc($qname);
2047
2048             if ( exists($qualifier_map{$qset}{$qname}) ) {
2049                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2050                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
2051             }
2052
2053             my @modifiers = $relation->getModifiers();
2054
2055             my $base = $relation->getBase();
2056             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2057
2058                 my $quote_it = 1;
2059                 foreach my $m ( @modifiers ) {
2060                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2061                         $quote_it = 0;
2062                         last;
2063                     }
2064                 }
2065
2066                 $quote_it = 0 if ( $base eq 'all' );
2067                 $term = maybeQuote($term) if $quote_it;
2068
2069             } else {
2070                 croak( "Evergreen doesn't support the $base relations" );
2071             }
2072
2073
2074         } else {
2075             $qualifier = "kw";
2076         }
2077
2078         return "$qualifier:$term";
2079     }
2080
2081     sub toEvergreenAuth {
2082         my $self      = shift;
2083         my $qualifier = $self->getQualifier();
2084         my $term      = $self->getTerm();
2085         my $relation  = $self->getRelation();
2086
2087         my $query;
2088         if ( $qualifier ) {
2089             my ($qset, $qname) = split(/\./, $qualifier);
2090
2091             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2092                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2093                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2094             }
2095         }
2096         return { qualifier => $qualifier, term => $term };
2097     }
2098 }
2099
2100 my $auth_ex_doc;
2101 sub sru_auth_search {
2102     my $cgi = new CGI;
2103
2104     check_child_init();
2105
2106     my $req = SRU::Request->newFromCGI( $cgi );
2107     my $resp = SRU::Response->newFromRequest( $req );
2108
2109     if ( $resp->type eq 'searchRetrieve' ) {
2110         return_auth_response($cgi, $req, $resp);
2111     } elsif ( $resp->type eq 'explain' ) {
2112         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2113             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2114             \%OpenILS::WWW::SuperCat::qualifier_ids
2115         );
2116     }
2117
2118     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2119     print $U->entityize($resp->asXML) . "\n";
2120     return Apache2::Const::OK;
2121 }
2122
2123 sub explain_header {
2124     my $cgi = shift;
2125
2126     my $host = $cgi->virtual_host || $cgi->server_name;
2127
2128     my $add_path = 0;
2129     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2130         my $rel_name = $cgi->url(-relative=>1);
2131         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2132     }
2133     my $base = $cgi->url(-base=>1);
2134     my $url = $cgi->url(-path_info=>$add_path);
2135     $url =~ s/^$base\///o;
2136
2137     my $doc = $parser->parse_string($base_explain);
2138     my $e = $doc->documentElement;
2139     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2140     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2141     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2142
2143     return ($doc, $e);
2144 }
2145
2146 sub return_sru_explain {
2147     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2148
2149     $index_map ||= \%qualifier_map;
2150     if (!$$explain) {
2151         my ($doc, $e) = explain_header($cgi);
2152         for my $name ( keys %{$index_map} ) {
2153
2154             my $identifier = $qualifier_ids->{ $name };
2155
2156             next unless $identifier;
2157
2158             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2159             $set_node->setAttribute( identifier => $identifier );
2160             $set_node->setAttribute( name => $name );
2161
2162             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2163             for my $index ( sort keys %{$index_map->{$name}} ) {
2164                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2165
2166                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2167                 $map_node->appendChild( $name_node );
2168
2169                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2170
2171                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2172                 $index_node->appendChild( $title_node );
2173                 $index_node->appendChild( $map_node );
2174
2175                 $index_node->setAttribute( id => "$name.$index" );
2176                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2177                 $name_node->setAttribute( set => $name );
2178                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2179
2180                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2181             }
2182         }
2183
2184         $$explain = $e->toString;
2185     }
2186
2187     $resp->record(
2188         SRU::Response::Record->new(
2189             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2190             recordData      => $$explain
2191         )
2192     );
2193
2194 }
2195
2196 sub return_auth_response {
2197     my ($cgi, $req, $resp) = @_;
2198
2199     my $cql_query = decode_utf8($req->query);
2200     my $search = $req->cql->toEvergreenAuth;
2201
2202     my $qualifier = decode_utf8($search->{qualifier});
2203     my $term = decode_utf8($search->{term});
2204
2205     $log->info("SRU NAF search string [$cql_query] converted to "
2206         . "[$qualifier:$term]\n");
2207
2208     my $page_size = $req->maximumRecords;
2209     $page_size ||= 10;
2210
2211     # startwith deals with pages, so convert startRecord to a page number
2212     my $page = ($req->startRecord / $page_size) || 0;
2213
2214     my $recs;
2215     if ($qualifier eq "id") {
2216         $recs = [ int($term) ];
2217     } else {
2218         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2219
2220         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2221         $method .= ".refs" if $refs;
2222
2223         $recs = $supercat->request(
2224             $method,
2225             $realaxis,
2226             $term,
2227             $page,
2228             $page_size
2229         )->gather(1);
2230     }
2231
2232     my $record_position = $req->startRecord;
2233     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2234     foreach my $record (@$recs) {
2235         my $marcxml = $cstore->request(
2236             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2237         )->gather(1)->marc;
2238
2239         $resp->addRecord(
2240             SRU::Response::Record->new(
2241                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2242                 recordData => $marcxml,
2243                 recordPosition => ++$record_position
2244             )
2245         );
2246     }
2247
2248     $resp->numberOfRecords(scalar(@$recs));
2249 }
2250
2251 =head2 get_ou($org_unit)
2252
2253 Returns an aou object for a given actor.org_unit shortname or ID.
2254
2255 =cut
2256
2257 sub get_ou {
2258     my $org = shift || '-';
2259     my $org_unit;
2260
2261     if ($org eq '-') {
2262          $org_unit = $actor->request(
2263             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2264         )->gather(1);
2265     } elsif ($org !~ /^\d+$/o) {
2266          $org_unit = $actor->request(
2267             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2268         )->gather(1);
2269     } else {
2270          $org_unit = $actor->request(
2271             'open-ils.actor.org_unit_list.search' => id => $org
2272         )->gather(1);
2273     }
2274
2275     return $org_unit;
2276 }
2277
2278 1;
2279
2280 # vim: et:ts=4:sw=4