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