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