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
1205     if ($version eq '1.0') {
1206         print <<OSD;
1207 Content-type: application/opensearchdescription+xml; charset=utf-8
1208
1209 <?xml version="1.0" encoding="UTF-8"?>
1210 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1211   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&amp;startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
1212   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1213   <ShortName>$lib</ShortName>
1214   <LongName>Search $lib</LongName>
1215   <Description>Search the $lib OPAC by $class.</Description>
1216   <Tags>$lib book library</Tags>
1217   <SampleSearch>harry+potter</SampleSearch>
1218   <Developer>Mike Rylander for GPLS/PINES</Developer>
1219   <Contact>feedback\@open-ils.org</Contact>
1220   <SyndicationRight>open</SyndicationRight>
1221   <AdultContent>false</AdultContent>
1222 </OpenSearchDescription>
1223 OSD
1224     } else {
1225         print <<OSD;
1226 Content-type: application/opensearchdescription+xml; charset=utf-8
1227
1228 <?xml version="1.0" encoding="UTF-8"?>
1229 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1230   <ShortName>$lib</ShortName>
1231   <Description>Search the $lib OPAC by $class.</Description>
1232   <Tags>$lib book library</Tags>
1233   <Url type="application/rss+xml"
1234        template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1235   <Url type="application/atom+xml"
1236        template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1237   <Url type="application/x-mods3+xml"
1238        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1239   <Url type="application/x-mods+xml"
1240        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1241   <Url type="application/octet-stream"
1242        template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1243   <Url type="application/x-marcxml+xml"
1244        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1245   <Url type="text/html"
1246        template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1247   <LongName>Search $lib</LongName>
1248   <Query role="example" searchTerms="harry+potter" />
1249   <Developer>Mike Rylander for GPLS/PINES</Developer>
1250   <Contact>feedback\@open-ils.org</Contact>
1251   <SyndicationRight>open</SyndicationRight>
1252   <AdultContent>false</AdultContent>
1253   <Language>en-US</Language>
1254   <OutputEncoding>UTF-8</OutputEncoding>
1255   <InputEncoding>UTF-8</InputEncoding>
1256 </OpenSearchDescription>
1257 OSD
1258     }
1259
1260     return Apache2::Const::OK;
1261 }
1262
1263 sub opensearch_feed {
1264     my $apache = shift;
1265     return Apache2::Const::DECLINED if (-e $apache->filename);
1266
1267     check_child_init();
1268
1269     my $cgi = new CGI;
1270     my $year = (gmtime())[5] + 1900;
1271
1272     my $host = $cgi->virtual_host || $cgi->server_name;
1273
1274     my $add_path = 0;
1275     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1276         my $rel_name = $cgi->url(-relative=>1);
1277         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1278     }
1279
1280     my $url = $cgi->url(-path_info=>$add_path);
1281     my $root = (split 'opensearch', $url)[0];
1282     my $base = (split 'opensearch', $url)[0] . 'opensearch';
1283     my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1284
1285     my $path = $cgi->path_info;
1286     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1287
1288     if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1289
1290         my $version = $1;
1291         my $lib = uc($2);
1292         my $class = $3;
1293
1294         if (!$lib || $lib eq '-') {
1295              $lib = $actor->request(
1296                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1297             )->gather(1)->[0]->shortname;
1298         }
1299
1300         if ($class eq '-') {
1301             $class = 'keyword';
1302         }
1303
1304         return opensearch_osd($version, $lib, $class, $base);
1305     }
1306
1307
1308     my $page = $cgi->param('startPage') || 1;
1309     my $offset = $cgi->param('startIndex') || 1;
1310     my $limit = $cgi->param('count') || 10;
1311
1312     $page = 1 if ($page !~ /^\d+$/);
1313     $offset = 1 if ($offset !~ /^\d+$/);
1314     $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1315
1316     if ($page > 1) {
1317         $offset = ($page - 1) * $limit;
1318     } else {
1319         $offset -= 1;
1320     }
1321
1322     my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1323     (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1324
1325     $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1326     $lang = '' if ($lang eq '*');
1327
1328     $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1329     $sort ||= '';
1330     $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1331     $sortdir ||= '';
1332
1333     $terms .= " " if ($terms && $cgi->param('searchTerms'));
1334     $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1335
1336     $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1337     $class ||= '-';
1338
1339     $type = $cgi->param('responseType') if $cgi->param('responseType');
1340     $type ||= '-';
1341
1342     $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1343     $org ||= '-';
1344
1345
1346     my $kwt = $cgi->param('kw');
1347     my $tit = $cgi->param('ti');
1348     my $aut = $cgi->param('au');
1349     my $sut = $cgi->param('su');
1350     my $set = $cgi->param('se');
1351
1352     $terms .= " " if ($terms && $kwt);
1353     $terms .= "keyword: $kwt" if ($kwt);
1354     $terms .= " " if ($terms && $tit);
1355     $terms .= "title: $tit" if ($tit);
1356     $terms .= " " if ($terms && $aut);
1357     $terms .= "author: $aut" if ($aut);
1358     $terms .= " " if ($terms && $sut);
1359     $terms .= "subject: $sut" if ($sut);
1360     $terms .= " " if ($terms && $set);
1361     $terms .= "series: $set" if ($set);
1362
1363     if ($version eq '1.0') {
1364         $type = 'rss2';
1365     } elsif ($type eq '-') {
1366         $type = 'atom';
1367     }
1368     my $flesh_feed = parse_feed_type($type);
1369
1370     $terms = decode_utf8($terms);
1371     $lang = 'eng' if ($lang eq 'en-US');
1372
1373     $log->debug("OpenSearch terms: $terms");
1374
1375     my $org_unit = get_ou($org);
1376
1377     # Apostrophes break search and get indexed as spaces anyway
1378     my $safe_terms = $terms;
1379     $safe_terms =~ s{'}{ }go;
1380
1381     my $recs = $search->request(
1382         'open-ils.search.biblio.multiclass.query' => {
1383             org_unit    => $org_unit->[0]->id,
1384             offset        => $offset,
1385             limit        => $limit,
1386             sort        => $sort,
1387             sort_dir    => $sortdir,
1388             default_class => $class,
1389             ($lang ?    ( 'language' => $lang    ) : ()),
1390         } => $safe_terms => 1
1391     )->gather(1);
1392
1393     $log->debug("Hits for [$terms]: $recs->{count}");
1394
1395     my $feed = create_record_feed(
1396         'record',
1397         $type,
1398         [ map { $_->[0] } @{$recs->{ids}} ],
1399         $unapi,
1400         $org,
1401         undef,
1402         $flesh_feed
1403     );
1404
1405     $log->debug("Feed created...");
1406
1407     $feed->root($root);
1408     $feed->lib($org);
1409     $feed->search($safe_terms);
1410     $feed->class($class);
1411
1412     $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1413
1414     $feed->creator($host);
1415     $feed->update_ts();
1416
1417     $feed->_create_node(
1418         $feed->{item_xpath},
1419         'http://a9.com/-/spec/opensearch/1.1/',
1420         'totalResults',
1421         $recs->{count},
1422     );
1423
1424     $feed->_create_node(
1425         $feed->{item_xpath},
1426         'http://a9.com/-/spec/opensearch/1.1/',
1427         'startIndex',
1428         $offset + 1,
1429     );
1430
1431     $feed->_create_node(
1432         $feed->{item_xpath},
1433         'http://a9.com/-/spec/opensearch/1.1/',
1434         'itemsPerPage',
1435         $limit,
1436     );
1437
1438     $log->debug("...basic feed data added...");
1439
1440     $feed->link(
1441         next =>
1442         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1443         'application/opensearch+xml'
1444     ) if ($offset + $limit < $recs->{count});
1445
1446     $feed->link(
1447         previous =>
1448         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1449         'application/opensearch+xml'
1450     ) if ($offset);
1451
1452     $feed->link(
1453         self =>
1454         $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1455         'application/opensearch+xml'
1456     );
1457
1458     $feed->link(
1459         alternate =>
1460         $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1461         'application/rss+xml'
1462     );
1463
1464     $feed->link(
1465         atom =>
1466         $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1467         'application/atom+xml'
1468     );
1469
1470     $feed->link(
1471         'html' =>
1472         $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1473         'text/html'
1474     );
1475
1476     $feed->link(
1477         'html-full' =>
1478         $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1479         'text/html'
1480     );
1481
1482     $feed->link( 'unapi-server' => $unapi);
1483
1484     $log->debug("...feed links added...");
1485
1486 #    $feed->link(
1487 #        opac =>
1488 #        $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1489 #            join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1490 #        'text/html'
1491 #    );
1492
1493     #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1494     print $cgi->header(
1495         -type => $feed->type, -charset => 'UTF-8',
1496         extra_headers_per_type_to_cgi($type)
1497     ), $feed->toString, "\n";
1498
1499     $log->debug("...and feed returned.");
1500
1501     return Apache2::Const::OK;
1502 }
1503
1504 sub create_record_feed {
1505     my $search = shift;
1506     my $type = shift;
1507     my $records = shift;
1508     my $unapi = shift;
1509
1510     my $lib = uc(shift()) || '-';
1511     my $depth = shift;
1512     my $flesh = shift;
1513
1514     my $paging = shift;
1515
1516     my $cgi = new CGI;
1517     my $base = $cgi->url;
1518     my $host = $cgi->virtual_host || $cgi->server_name;
1519
1520     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1521     $year += 1900;
1522     $month += 1;
1523
1524     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1525
1526     my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1527
1528     $type =~ s/(-full|-uris)$//o;
1529
1530     my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1531     $feed->base($base) if ($flesh);
1532     $feed->unapi($unapi) if ($flesh);
1533
1534     $type = 'atom' if ($type eq 'html');
1535     $type = 'marcxml' if
1536         $type eq 'htmlholdings' or
1537         $type eq 'marctxt' or
1538         $type eq 'ris' or
1539         $type eq 'marc21';  # kludgy since it isn't an XML format, but needed
1540
1541     #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1542
1543     my $count = 0;
1544     for my $record (@$records) {
1545         next unless($record);
1546
1547         #my $rec = $record->id;
1548         my $rec = $record;
1549
1550         my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1551         $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1552         $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1553         $item_tag .= "/$depth" if (defined($depth));
1554
1555         $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1556
1557         my $xml = $supercat->request(
1558             "open-ils.supercat.$search.$type.retrieve",
1559             $rec
1560         )->gather(1);
1561         next unless $xml;
1562
1563         my $node = $feed->add_item($xml);
1564         next unless $node;
1565
1566         $xml = '';
1567         if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1568             my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1569             while ( !$r->complete ) {
1570                 $xml .= join('', map {$_->content} $r->recv);
1571             }
1572             $xml .= join('', map {$_->content} $r->recv);
1573             $node->add_holdings($xml);
1574         }
1575
1576         $node->id($item_tag);
1577         #$node->update_ts(cleanse_ISO8601($record->edit_date));
1578         $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1579         $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1580         $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1581         $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1582         $node->link('unapi-id' => $item_tag) if ($flesh);
1583     }
1584
1585     return $feed;
1586 }
1587
1588 sub string_browse {
1589     my $apache = shift;
1590     return Apache2::Const::DECLINED if (-e $apache->filename);
1591
1592     check_child_init();
1593
1594     my $cgi = new CGI;
1595     my $year = (gmtime())[5] + 1900;
1596
1597     my $host = $cgi->virtual_host || $cgi->server_name;
1598
1599     my $add_path = 0;
1600     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1601         my $rel_name = $cgi->url(-relative=>1);
1602         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1603     }
1604
1605     my $url = $cgi->url(-path_info=>$add_path);
1606     my $root = (split 'browse', $url)[0];
1607     my $base = (split 'browse', $url)[0] . 'browse';
1608     my $unapi = (split 'browse', $url)[0] . 'unapi';
1609
1610     my $path = $cgi->path_info;
1611     $path =~ s/^\///og;
1612
1613     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1614     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1615
1616     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1617
1618     my $status = [$cgi->param('status')];
1619     my $cpLoc = [$cgi->param('copyLocation')];
1620     $site ||= $cgi->param('searchOrg');
1621     $page ||= $cgi->param('startPage') || 0;
1622     $page_size ||= $cgi->param('count') || 9;
1623
1624     $page = 0 if ($page !~ /^-?\d+$/);
1625     $page_size = 9 if $page_size !~ /^\d+$/;
1626
1627     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1628     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1629
1630     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1631         warn "something's wrong...";
1632         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1633         return undef;
1634     }
1635
1636     $string = decode_utf8($string);
1637     $string =~ s/\+/ /go;
1638     $string =~ s/'//go;
1639
1640     my $tree;
1641     if ($axis =~ /^authority/) {
1642         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1643
1644         my $method = "open-ils.supercat.authority.browse_center.by_axis";
1645         $method .= ".refs" if $refs;
1646
1647         $tree = $supercat->request(
1648             $method,
1649             $realaxis,
1650             $string,
1651             $page,
1652             $page_size
1653         )->gather(1);
1654     } else {
1655         $tree = $supercat->request(
1656             "open-ils.supercat.$axis.browse",
1657             $string,
1658             $site,
1659             $page_size,
1660             $page,
1661             $status,
1662             $cpLoc
1663         )->gather(1);
1664     }
1665
1666     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1667
1668     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1669     print $header.$content;
1670     return Apache2::Const::OK;
1671 }
1672
1673 sub string_startwith {
1674     my $apache = shift;
1675     return Apache2::Const::DECLINED if (-e $apache->filename);
1676
1677     check_child_init();
1678
1679     my $cgi = new CGI;
1680     my $year = (gmtime())[5] + 1900;
1681
1682     my $host = $cgi->virtual_host || $cgi->server_name;
1683
1684     my $add_path = 0;
1685     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1686         my $rel_name = $cgi->url(-relative=>1);
1687         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1688     }
1689
1690     my $url = $cgi->url(-path_info=>$add_path);
1691     my $root = (split 'startwith', $url)[0];
1692     my $base = (split 'startwith', $url)[0] . 'startwith';
1693     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1694
1695     my $path = $cgi->path_info;
1696     $path =~ s/^\///og;
1697
1698     my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1699     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1700
1701     my $status = [$cgi->param('status')];
1702     my $cpLoc = [$cgi->param('copyLocation')];
1703     $site ||= $cgi->param('searchOrg');
1704     $page ||= $cgi->param('startPage') || 0;
1705     $page_size ||= $cgi->param('count') || 9;
1706
1707     $page = 0 if ($page !~ /^-?\d+$/);
1708     $page_size = 9 if $page_size !~ /^\d+$/;
1709
1710     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1711     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1712
1713     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1714         warn "something's wrong...";
1715         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1716         return undef;
1717     }
1718
1719     $string = decode_utf8($string);
1720     $string =~ s/\+/ /go;
1721     $string =~ s/'//go;
1722
1723     my $tree;
1724     if ($axis =~ /^authority/) {
1725         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1726
1727         my $method = "open-ils.supercat.authority.browse_top.by_axis";
1728         $method .= ".refs" if $refs;
1729
1730         $tree = $supercat->request(
1731             $method,
1732             $realaxis,
1733             $string,
1734             $page,
1735             $page_size
1736         )->gather(1);
1737     } else {
1738         $tree = $supercat->request(
1739             "open-ils.supercat.$axis.startwith",
1740             $string,
1741             $site,
1742             $page_size,
1743             $page,
1744             $status,
1745             $cpLoc
1746         )->gather(1);
1747     }
1748
1749     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1750
1751     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1752     print $header.$content;
1753     return Apache2::Const::OK;
1754 }
1755
1756 sub item_age_browse {
1757     my $apache = shift;
1758     return Apache2::Const::DECLINED if (-e $apache->filename);
1759
1760     check_child_init();
1761
1762     my $cgi = new CGI;
1763     my $year = (gmtime())[5] + 1900;
1764
1765     my $host = $cgi->virtual_host || $cgi->server_name;
1766
1767     my $add_path = 0;
1768     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1769         my $rel_name = $cgi->url(-relative=>1);
1770         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1771     }
1772
1773     my $url = $cgi->url(-path_info=>$add_path);
1774     my $root = (split 'browse', $url)[0];
1775     my $base = (split 'browse', $url)[0] . 'browse';
1776     my $unapi = (split 'browse', $url)[0] . 'unapi';
1777
1778     my $path = $cgi->path_info;
1779     $path =~ s/^\///og;
1780
1781     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1782     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1783
1784     unless ($axis eq 'item-age') {
1785         warn "something's wrong...";
1786         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1787         return undef;
1788     }
1789
1790     my $status = [$cgi->param('status')];
1791     my $cpLoc = [$cgi->param('copyLocation')];
1792     $site ||= $cgi->param('searchOrg') || '-';
1793     $page ||= $cgi->param('startPage') || 1;
1794     $page_size ||= $cgi->param('count') || 10;
1795
1796     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1797     $page_size = 10 if $page_size !~ /^\d+$/;
1798
1799     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1800     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1801
1802     my $recs = $supercat->request(
1803         "open-ils.supercat.new_book_list",
1804         $site,
1805         $page_size,
1806         $page,
1807         $status,
1808         $cpLoc
1809     )->gather(1);
1810
1811     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1812
1813     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1814     print $header.$content;
1815     return Apache2::Const::OK;
1816 }
1817
1818 our %qualifier_ids = (
1819     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1820     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1821     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1822     srw => ''
1823 );
1824
1825 # Our authority search options are currently pretty impoverished;
1826 # just right-truncated string match on a few categories, or by
1827 # ID number
1828 our %nested_auth_qualifier_map = (
1829         eg => {
1830             id          => { index => 'id', title => 'Record number'},
1831             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1832             title       => { index => 'title', title => 'Uniform title'},
1833             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1834             topic       => { index => 'topic', title => 'Topical term'},
1835         },
1836 );
1837
1838 my $base_explain = <<XML;
1839 <explain
1840         id="evergreen-sru-explain-full"
1841         authoritative="true"
1842         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1843         xmlns="http://explain.z3950.org/dtd/2.0/">
1844     <serverInfo transport="http" protocol="SRU" version="1.1">
1845         <host/>
1846         <port/>
1847         <database/>
1848     </serverInfo>
1849
1850     <databaseInfo>
1851         <title primary="true"/>
1852         <description primary="true"/>
1853     </databaseInfo>
1854
1855     <indexInfo>
1856         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1857     </indexInfo>
1858
1859     <schemaInfo>
1860         <schema
1861                 identifier="info:srw/schema/1/marcxml-v1.1"
1862                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1863                 sort="true"
1864                 retrieve="true"
1865                 name="marcxml">
1866             <title>MARC21Slim (marcxml)</title>
1867         </schema>
1868     </schemaInfo>
1869
1870     <configInfo>
1871         <default type="numberOfRecords">10</default>
1872         <default type="contextSet">eg</default>
1873         <default type="index">keyword</default>
1874         <default type="relation">all</default>
1875         <default type="sortSchema">marcxml</default>
1876         <default type="retrieveSchema">marcxml</default>
1877         <setting type="maximumRecords">50</setting>
1878         <supports type="relationModifier">relevant</supports>
1879         <supports type="relationModifier">stem</supports>
1880         <supports type="relationModifier">fuzzy</supports>
1881         <supports type="relationModifier">word</supports>
1882     </configInfo>
1883
1884 </explain>
1885 XML
1886
1887
1888 my $ex_doc;
1889 sub sru_search {
1890     my $cgi = new CGI;
1891
1892     check_child_init();
1893
1894     my $req = SRU::Request->newFromCGI( $cgi );
1895     my $resp = SRU::Response->newFromRequest( $req );
1896
1897     # Find the org_unit shortname, if passed as part of the URL
1898     # http://example.com/opac/extras/sru/SHORTNAME
1899     my $url = $cgi->path_info;
1900     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1901
1902     if ( $resp->type eq 'searchRetrieve' ) {
1903
1904         # Older versions of Debian packages returned terms to us double-encoded,
1905         # so we had to forcefully double-decode them a second time with
1906         # an outer decode('utf8', $string) call; this seems to be resolved with
1907         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1908         my $cql_query = decode_utf8($req->query);
1909         my $search_string = decode_utf8($req->cql->toEvergreen);
1910
1911         # Ensure the search string overrides the default site
1912         if ($shortname and $search_string !~ m#site:#) {
1913             $search_string .= " site:$shortname";
1914         }
1915
1916         my $offset = $req->startRecord;
1917         $offset-- if ($offset);
1918         $offset ||= 0;
1919
1920         my $limit = $req->maximumRecords;
1921         $limit ||= 10;
1922
1923         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1924
1925          my $recs = $search->request(
1926             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1927         )->gather(1);
1928
1929         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1930
1931         foreach my $record (@$bre) {
1932             my $marcxml = $record->marc;
1933             # Make the beast conform to a VDX-supported format
1934             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1935             # Trying to implement LIBSOL_852_A format; so much for standards
1936             if ($holdings) {
1937                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1938                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1939
1940                 # Force record leader to 'a' as our data is always UTF8
1941                 # Avoids marc8_to_utf8 from being invoked with horrible results
1942                 # on the off-chance the record leader isn't correct
1943                 my $ldr = $marc->leader;
1944                 substr($ldr, 9, 1, 'a');
1945                 $marc->leader($ldr);
1946
1947                 # Expects the record ID in the 001
1948                 $marc->delete_field($_) for ($marc->field('001'));
1949                 if (!$marc->field('001')) {
1950                     $marc->insert_fields_ordered(
1951                         MARC::Field->new( '001', $record->id )
1952                     );
1953                 }
1954                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1955                 foreach my $cn (keys %$bib_holdings) {
1956                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1957                         $marc->insert_fields_ordered(
1958                             MARC::Field->new(
1959                                 '852', '4', '',
1960                                 a => $cp->{'location'},
1961                                 b => $bib_holdings->{$cn}->{'owning_lib'},
1962                                 c => $cn,
1963                                 d => $cp->{'circlib'},
1964                                 g => $cp->{'barcode'},
1965                                 n => $cp->{'status'},
1966                             )
1967                         );
1968                     }
1969                 }
1970
1971                 # Ensure the data is encoded as UTF8 before we hand it off
1972                 $marcxml = encode_utf8($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' );
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' );
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