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     (my $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     my $safe_terms = $terms;
1442     $safe_terms =~ s{'}{ }go;
1443
1444     my $recs = $search->request(
1445         'open-ils.search.biblio.multiclass.query' => {
1446             org_unit    => $org_unit->[0]->id,
1447             offset        => $offset,
1448             limit        => $limit,
1449             sort        => $sort,
1450             sort_dir    => $sortdir,
1451             default_class => $class,
1452             ($lang ?    ( 'language' => $lang    ) : ()),
1453         } => $safe_terms => 1
1454     )->gather(1);
1455
1456     $log->debug("Hits for [$terms]: $recs->{count}");
1457
1458     my $feed = create_record_feed(
1459         'record',
1460         $type,
1461         [ map { $_->[0] } @{$recs->{ids}} ],
1462         $unapi,
1463         $org,
1464         undef,
1465         $flesh_feed
1466     );
1467
1468     $log->debug("Feed created...");
1469
1470     $feed->root($root);
1471     $feed->lib($org);
1472     $feed->search($safe_terms);
1473     $feed->class($class);
1474
1475     $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1476
1477     $feed->creator($host);
1478     $feed->update_ts();
1479
1480     $feed->_create_node(
1481         $feed->{item_xpath},
1482         'http://a9.com/-/spec/opensearch/1.1/',
1483         'totalResults',
1484         $recs->{count},
1485     );
1486
1487     $feed->_create_node(
1488         $feed->{item_xpath},
1489         'http://a9.com/-/spec/opensearch/1.1/',
1490         'startIndex',
1491         $offset + 1,
1492     );
1493
1494     $feed->_create_node(
1495         $feed->{item_xpath},
1496         'http://a9.com/-/spec/opensearch/1.1/',
1497         'itemsPerPage',
1498         $limit,
1499     );
1500
1501     $log->debug("...basic feed data added...");
1502
1503     $feed->link(
1504         next =>
1505         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1506         'application/opensearch+xml'
1507     ) if ($offset + $limit < $recs->{count});
1508
1509     $feed->link(
1510         previous =>
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);
1514
1515     $feed->link(
1516         self =>
1517         $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1518         'application/opensearch+xml'
1519     );
1520
1521     $feed->link(
1522         alternate =>
1523         $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1524         'application/rss+xml'
1525     );
1526
1527     $feed->link(
1528         atom =>
1529         $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1530         'application/atom+xml'
1531     );
1532
1533     $feed->link(
1534         'html' =>
1535         $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1536         'text/html'
1537     );
1538
1539     $feed->link(
1540         'html-full' =>
1541         $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1542         'text/html'
1543     );
1544
1545     $feed->link( 'unapi-server' => $unapi);
1546
1547     $log->debug("...feed links added...");
1548
1549 #    $feed->link(
1550 #        opac =>
1551 #        $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1552 #            join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1553 #        'text/html'
1554 #    );
1555
1556     #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1557     print $cgi->header(
1558         -type => $feed->type, -charset => 'UTF-8',
1559         extra_headers_per_type_to_cgi($type)
1560     ), $feed->toString, "\n";
1561
1562     $log->debug("...and feed returned.");
1563
1564     return Apache2::Const::OK;
1565 }
1566
1567 sub create_record_feed {
1568     my $search = shift;
1569     my $type = shift;
1570     my $records = shift;
1571     my $unapi = shift;
1572
1573     my $lib = uc(shift()) || '-';
1574     my $depth = shift;
1575     my $flesh = shift;
1576
1577     my $paging = shift;
1578
1579     my $cgi = new CGI;
1580     my $base = $cgi->url;
1581     my $host = $cgi->virtual_host || $cgi->server_name;
1582
1583     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1584     $year += 1900;
1585     $month += 1;
1586
1587     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1588
1589     my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1590
1591     $type =~ s/(-full|-uris)$//o;
1592
1593     my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1594     $feed->base($base) if ($flesh);
1595     $feed->unapi($unapi) if ($flesh);
1596
1597     $type = 'atom' if ($type eq 'html');
1598     $type = 'marcxml' if
1599         $type eq 'htmlholdings' or
1600         $type eq 'marctxt' or
1601         $type eq 'ris' or
1602         $type eq 'marc21';  # kludgy since it isn't an XML format, but needed
1603
1604     #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1605
1606     my $count = 0;
1607     for my $record (@$records) {
1608         next unless($record);
1609
1610         #my $rec = $record->id;
1611         my $rec = $record;
1612
1613         my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1614         $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1615         $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1616         $item_tag .= "/$depth" if (defined($depth));
1617
1618         $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1619
1620         my $xml = $supercat->request(
1621             "open-ils.supercat.$search.$type.retrieve",
1622             $rec
1623         )->gather(1);
1624         next unless $xml;
1625
1626         my $node = $feed->add_item($xml);
1627         next unless $node;
1628
1629         $xml = '';
1630         if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1631             my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1632             while ( !$r->complete ) {
1633                 $xml .= join('', map {$_->content} $r->recv);
1634             }
1635             $xml .= join('', map {$_->content} $r->recv);
1636             $node->add_holdings($xml);
1637         }
1638
1639         $node->id($item_tag);
1640         #$node->update_ts(cleanse_ISO8601($record->edit_date));
1641         $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1642         $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1643         $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1644         $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1645         $node->link('unapi-id' => $item_tag) if ($flesh);
1646     }
1647
1648     return $feed;
1649 }
1650
1651 sub string_browse {
1652     my $apache = shift;
1653     return Apache2::Const::DECLINED if (-e $apache->filename);
1654
1655     check_child_init();
1656
1657     my $cgi = new CGI;
1658     my $year = (gmtime())[5] + 1900;
1659
1660     my $host = $cgi->virtual_host || $cgi->server_name;
1661
1662     my $add_path = 0;
1663     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1664         my $rel_name = $cgi->url(-relative=>1);
1665         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1666     }
1667
1668     my $url = $cgi->url(-path_info=>$add_path);
1669     my $root = (split 'browse', $url)[0];
1670     my $base = (split 'browse', $url)[0] . 'browse';
1671     my $unapi = (split 'browse', $url)[0] . 'unapi';
1672
1673     my $path = $cgi->path_info;
1674     $path =~ s/^\///og;
1675
1676     my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1677     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1678
1679     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1680
1681     my $status = [$cgi->param('status')];
1682     my $cpLoc = [$cgi->param('copyLocation')];
1683     $site ||= $cgi->param('searchOrg');
1684     $page ||= $cgi->param('startPage') || 0;
1685     $page_size ||= $cgi->param('count') || 9;
1686     $thesauruses //= '';
1687     $thesauruses =~ s/\s//g;
1688     # protect against cats bouncing on the comma key...
1689     $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1690
1691     $page = 0 if ($page !~ /^-?\d+$/);
1692     $page_size = 9 if $page_size !~ /^\d+$/;
1693
1694     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1695     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1696
1697     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1698         warn "something's wrong...";
1699         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1700         return undef;
1701     }
1702
1703     $string = decode_utf8($string);
1704     $string =~ s/\+/ /go;
1705     $string =~ s/'//go;
1706
1707     my $tree;
1708     if ($axis =~ /^authority/) {
1709         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1710
1711         my $method = "open-ils.supercat.authority.browse_center.by_axis";
1712         $method .= ".refs" if $refs;
1713
1714         $tree = $supercat->request(
1715             $method,
1716             $realaxis,
1717             $string,
1718             $page,
1719             $page_size,
1720             $thesauruses
1721         )->gather(1);
1722     } else {
1723         $tree = $supercat->request(
1724             "open-ils.supercat.$axis.browse",
1725             $string,
1726             $site,
1727             $page_size,
1728             $page,
1729             $status,
1730             $cpLoc
1731         )->gather(1);
1732     }
1733
1734     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1735
1736     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1737     print $header.$content;
1738     return Apache2::Const::OK;
1739 }
1740
1741 sub string_startwith {
1742     my $apache = shift;
1743     return Apache2::Const::DECLINED if (-e $apache->filename);
1744
1745     check_child_init();
1746
1747     my $cgi = new CGI;
1748     my $year = (gmtime())[5] + 1900;
1749
1750     my $host = $cgi->virtual_host || $cgi->server_name;
1751
1752     my $add_path = 0;
1753     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1754         my $rel_name = $cgi->url(-relative=>1);
1755         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1756     }
1757
1758     my $url = $cgi->url(-path_info=>$add_path);
1759     my $root = (split 'startwith', $url)[0];
1760     my $base = (split 'startwith', $url)[0] . 'startwith';
1761     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1762
1763     my $path = $cgi->path_info;
1764     $path =~ s/^\///og;
1765
1766     my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1767     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1768
1769     my $status = [$cgi->param('status')];
1770     my $cpLoc = [$cgi->param('copyLocation')];
1771     $site ||= $cgi->param('searchOrg');
1772     $page ||= $cgi->param('startPage') || 0;
1773     $page_size ||= $cgi->param('count') || 9;
1774     $thesauruses //= '';
1775     $thesauruses =~ s/\s//g;
1776     # protect against cats bouncing on the comma key...
1777     $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1778
1779     $page = 0 if ($page !~ /^-?\d+$/);
1780     $page_size = 9 if $page_size !~ /^\d+$/;
1781
1782     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1783     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1784
1785     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1786         warn "something's wrong...";
1787         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1788         return undef;
1789     }
1790
1791     $string = decode_utf8($string);
1792     $string =~ s/\+/ /go;
1793     $string =~ s/'//go;
1794
1795     my $tree;
1796     if ($axis =~ /^authority/) {
1797         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1798
1799         my $method = "open-ils.supercat.authority.browse_top.by_axis";
1800         $method .= ".refs" if $refs;
1801
1802         $tree = $supercat->request(
1803             $method,
1804             $realaxis,
1805             $string,
1806             $page,
1807             $page_size,
1808             $thesauruses
1809         )->gather(1);
1810     } else {
1811         $tree = $supercat->request(
1812             "open-ils.supercat.$axis.startwith",
1813             $string,
1814             $site,
1815             $page_size,
1816             $page,
1817             $status,
1818             $cpLoc
1819         )->gather(1);
1820     }
1821
1822     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1823
1824     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1825     print $header.$content;
1826     return Apache2::Const::OK;
1827 }
1828
1829 sub item_age_browse {
1830     my $apache = shift;
1831     return Apache2::Const::DECLINED if (-e $apache->filename);
1832
1833     check_child_init();
1834
1835     my $cgi = new CGI;
1836     my $year = (gmtime())[5] + 1900;
1837
1838     my $host = $cgi->virtual_host || $cgi->server_name;
1839
1840     my $add_path = 0;
1841     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1842         my $rel_name = $cgi->url(-relative=>1);
1843         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1844     }
1845
1846     my $url = $cgi->url(-path_info=>$add_path);
1847     my $root = (split 'browse', $url)[0];
1848     my $base = (split 'browse', $url)[0] . 'browse';
1849     my $unapi = (split 'browse', $url)[0] . 'unapi';
1850
1851     my $path = $cgi->path_info;
1852     $path =~ s/^\///og;
1853
1854     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1855     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1856
1857     unless ($axis eq 'item-age') {
1858         warn "something's wrong...";
1859         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1860         return undef;
1861     }
1862
1863     my $status = [$cgi->param('status')];
1864     my $cpLoc = [$cgi->param('copyLocation')];
1865     $site ||= $cgi->param('searchOrg') || '-';
1866     $page ||= $cgi->param('startPage') || 1;
1867     $page_size ||= $cgi->param('count') || 10;
1868
1869     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1870     $page_size = 10 if $page_size !~ /^\d+$/;
1871
1872     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1873     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1874
1875     my $recs = $supercat->request(
1876         "open-ils.supercat.new_book_list",
1877         $site,
1878         $page_size,
1879         $page,
1880         $status,
1881         $cpLoc
1882     )->gather(1);
1883
1884     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1885
1886     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1887     print $header.$content;
1888     return Apache2::Const::OK;
1889 }
1890
1891 our %qualifier_ids = (
1892     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1893     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1894     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1895     srw => ''
1896 );
1897
1898 # Our authority search options are currently pretty impoverished;
1899 # just right-truncated string match on a few categories, or by
1900 # ID number
1901 our %nested_auth_qualifier_map = (
1902         eg => {
1903             id          => { index => 'id', title => 'Record number'},
1904             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1905             title       => { index => 'title', title => 'Uniform title'},
1906             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1907             topic       => { index => 'topic', title => 'Topical term'},
1908         },
1909 );
1910
1911 my $base_explain = <<XML;
1912 <explain
1913         id="evergreen-sru-explain-full"
1914         authoritative="true"
1915         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1916         xmlns="http://explain.z3950.org/dtd/2.0/">
1917     <serverInfo transport="http" protocol="SRU" version="1.1">
1918         <host/>
1919         <port/>
1920         <database/>
1921     </serverInfo>
1922
1923     <databaseInfo>
1924         <title primary="true"/>
1925         <description primary="true"/>
1926     </databaseInfo>
1927
1928     <indexInfo>
1929         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1930     </indexInfo>
1931
1932     <schemaInfo>
1933         <schema
1934                 identifier="info:srw/schema/1/marcxml-v1.1"
1935                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1936                 sort="true"
1937                 retrieve="true"
1938                 name="marcxml">
1939             <title>MARC21Slim (marcxml)</title>
1940         </schema>
1941     </schemaInfo>
1942
1943     <configInfo>
1944         <default type="numberOfRecords">10</default>
1945         <default type="contextSet">eg</default>
1946         <default type="index">keyword</default>
1947         <default type="relation">all</default>
1948         <default type="sortSchema">marcxml</default>
1949         <default type="retrieveSchema">marcxml</default>
1950         <setting type="maximumRecords">50</setting>
1951         <supports type="relationModifier">relevant</supports>
1952         <supports type="relationModifier">stem</supports>
1953         <supports type="relationModifier">fuzzy</supports>
1954         <supports type="relationModifier">word</supports>
1955     </configInfo>
1956
1957 </explain>
1958 XML
1959
1960
1961 my $ex_doc;
1962 sub sru_search {
1963     my $cgi = new CGI;
1964
1965     check_child_init();
1966
1967     my $req = SRU::Request->newFromCGI( $cgi );
1968     my $resp = SRU::Response->newFromRequest( $req );
1969
1970     # Find the org_unit shortname, if passed as part of the URL
1971     # http://example.com/opac/extras/sru/SHORTNAME
1972     my $url = $cgi->path_info;
1973     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1974
1975     if ( $resp->type eq 'searchRetrieve' ) {
1976
1977         # Older versions of Debian packages returned terms to us double-encoded,
1978         # so we had to forcefully double-decode them a second time with
1979         # an outer decode('utf8', $string) call; this seems to be resolved with
1980         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1981         my $cql_query = decode_utf8($req->query);
1982         my $search_string = decode_utf8($req->cql->toEvergreen);
1983
1984         # Ensure the search string overrides the default site
1985         if ($shortname and $search_string !~ m#site:#) {
1986             $search_string .= " site:$shortname";
1987         }
1988
1989         my $offset = $req->startRecord;
1990         $offset-- if ($offset);
1991         $offset ||= 0;
1992
1993         my $limit = $req->maximumRecords;
1994         $limit ||= 10;
1995
1996         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1997
1998         if (!$shortname || $shortname eq '-') {
1999             my $search_org = get_ou($shortname);
2000             $shortname = $search_org->[0]->shortname;
2001         }
2002
2003          my $recs = $search->request(
2004             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
2005         )->gather(1);
2006
2007         my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2008         foreach my $rec (@{$recs->{ids}}) {
2009             my $rec_id = shift @$rec;
2010             my $data = $cstore->request(
2011                 'open-ils.cstore.json_query' => {
2012                     from => [
2013                         'unapi.bre', $rec_id,
2014                         'marcxml', 'record',
2015                         ($holdings) ? '{holdings_xml,acp}' : '{}',
2016                         $shortname
2017                     ]
2018                 }
2019             )->gather(1);
2020             try {
2021                 my $marcxml = XML::LibXML->load_xml( string => $data->{'unapi.bre'} );
2022
2023                 # process <holdings> element, if any
2024                 my @copies;
2025                 for my $node ($marcxml->getElementsByTagName('holdings')) {
2026                     for my $volume ($node->getElementsByTagName('volume')) {
2027                         my $cn = $volume->getAttribute('label');
2028                         my $owning_lib = $volume->getAttribute('lib');
2029                         for my $copy ($volume->getElementsByTagName('copy')) {
2030                             push @copies, {
2031                                 a => $copy->getChildrenByTagName('location')->[0]->textContent,
2032                                 b => $owning_lib,
2033                                 c => $cn,
2034                                 d => $copy->getChildrenByTagName('circlib')->[0]->textContent,
2035                                 g => $copy->getAttribute('barcode'),
2036                                 n => $copy->getChildrenByTagName('status')->[0]->textContent
2037                             };
2038                         }
2039                     }
2040                     # remove <holdings> element
2041                     $node->parentNode->removeChild($node);
2042                 }
2043
2044                 my $marc = MARC::Record->new_from_xml($marcxml->toString(), 'UTF8', 'XML');
2045
2046                 # Force record leader to 'a' as our data is always UTF8
2047                 # Avoids marc8_to_utf8 from being invoked with horrible results
2048                 # on the off-chance the record leader isn't correct
2049                 my $ldr = $marc->leader;
2050                 substr($ldr, 9, 1, 'a');
2051                 $marc->leader($ldr);
2052
2053                 # Expects the record ID in the 001
2054                 $marc->delete_field($_) for ($marc->field('001'));
2055                 if (!$marc->field('001')) {
2056                     $marc->insert_fields_ordered(
2057                         MARC::Field->new( '001', $rec_id )
2058                     );
2059                 }
2060
2061                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
2062                 for my $copy (@copies) {
2063                     $marc->insert_fields_ordered(
2064                         MARC::Field->new(
2065                             '852', '4', '',
2066                             a => $copy->{a},
2067                             b => $copy->{b},
2068                             c => $copy->{c},
2069                             d => $copy->{d},
2070                             g => $copy->{g},
2071                             n => $copy->{n}
2072                         )
2073                     );
2074                 }
2075
2076                 my $output = $marc->as_xml_record();
2077                 $output =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2078                 $resp->addRecord(
2079                     SRU::Response::Record->new(
2080                         recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2081                         recordData => $output,
2082                         recordPosition => ++$offset
2083                     )
2084                 );
2085
2086             } catch Error with {
2087                 $log->error("Failed to process record for SRU search");
2088             }
2089         }
2090
2091         $resp->numberOfRecords($recs->{count});
2092
2093     } elsif ( $resp->type eq 'explain' ) {
2094         return_sru_explain($cgi, $req, $resp, \$ex_doc,
2095             undef,
2096             \%OpenILS::WWW::SuperCat::qualifier_ids
2097         );
2098
2099         $resp->record(
2100             SRU::Response::Record->new(
2101                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2102                 recordData        => $ex_doc
2103             )
2104         );
2105     }
2106
2107     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2108     print $U->entityize($resp->asXML) . "\n";
2109     return Apache2::Const::OK;
2110 }
2111
2112
2113 {
2114     package CQL::BooleanNode;
2115
2116     sub toEvergreen {
2117         my $self     = shift;
2118         my $left     = $self->left();
2119         my $right    = $self->right();
2120         my $leftStr  = $left->toEvergreen;
2121         my $rightStr = $right->toEvergreen();
2122
2123         my $op =  '||' if uc $self->op() eq 'OR';
2124         $op ||=  '&&';
2125
2126         return  "$leftStr $rightStr";
2127     }
2128
2129     sub toEvergreenAuth {
2130         return toEvergreen(shift);
2131     }
2132
2133     package CQL::TermNode;
2134
2135     sub toEvergreen {
2136         my $self      = shift;
2137         my $qualifier = $self->getQualifier();
2138         my $term      = $self->getTerm();
2139         my $relation  = $self->getRelation();
2140
2141         my $query;
2142         if ( $qualifier ) {
2143             my ($qset, $qname) = split(/\./, $qualifier);
2144
2145             # Per http://www.loc.gov/standards/sru/specs/cql.html
2146             # "All parts of CQL are case insensitive [...] If any case insensitive
2147             # part of CQL is specified with both upper and lower case, it is for
2148             # aesthetic purposes only."
2149
2150             # So fold the qualifier and relation to lower case
2151             $qset = lc($qset);
2152             $qname = lc($qname);
2153
2154             if ( exists($qualifier_map{$qset}{$qname}) ) {
2155                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2156                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
2157             }
2158
2159             my @modifiers = $relation->getModifiers();
2160
2161             my $base = $relation->getBase();
2162             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2163
2164                 my $quote_it = 1;
2165                 foreach my $m ( @modifiers ) {
2166                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2167                         $quote_it = 0;
2168                         last;
2169                     }
2170                 }
2171
2172                 $quote_it = 0 if ( $base eq 'all' );
2173                 $term = maybeQuote($term) if $quote_it;
2174
2175             } else {
2176                 croak( "Evergreen doesn't support the $base relations" );
2177             }
2178
2179
2180         } else {
2181             $qualifier = "kw";
2182         }
2183
2184         return "$qualifier:$term";
2185     }
2186
2187     sub toEvergreenAuth {
2188         my $self      = shift;
2189         my $qualifier = $self->getQualifier();
2190         my $term      = $self->getTerm();
2191         my $relation  = $self->getRelation();
2192
2193         my $query;
2194         if ( $qualifier ) {
2195             my ($qset, $qname) = split(/\./, $qualifier);
2196
2197             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2198                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2199                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2200             }
2201         }
2202         return { qualifier => $qualifier, term => $term };
2203     }
2204 }
2205
2206 my $auth_ex_doc;
2207 sub sru_auth_search {
2208     my $cgi = new CGI;
2209
2210     check_child_init();
2211
2212     my $req = SRU::Request->newFromCGI( $cgi );
2213     my $resp = SRU::Response->newFromRequest( $req );
2214
2215     if ( $resp->type eq 'searchRetrieve' ) {
2216         return_auth_response($cgi, $req, $resp);
2217     } elsif ( $resp->type eq 'explain' ) {
2218         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2219             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2220             \%OpenILS::WWW::SuperCat::qualifier_ids
2221         );
2222     }
2223
2224     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2225     print $U->entityize($resp->asXML) . "\n";
2226     return Apache2::Const::OK;
2227 }
2228
2229 sub explain_header {
2230     my $cgi = shift;
2231
2232     my $host = $cgi->virtual_host || $cgi->server_name;
2233
2234     my $add_path = 0;
2235     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2236         my $rel_name = $cgi->url(-relative=>1);
2237         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2238     }
2239     my $base = $cgi->url(-base=>1);
2240     my $url = $cgi->url(-path_info=>$add_path);
2241     $url =~ s/^$base\///o;
2242
2243     my $doc = $parser->parse_string($base_explain);
2244     my $e = $doc->documentElement;
2245     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2246     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2247     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2248
2249     return ($doc, $e);
2250 }
2251
2252 sub return_sru_explain {
2253     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2254
2255     $index_map ||= \%qualifier_map;
2256     if (!$$explain) {
2257         my ($doc, $e) = explain_header($cgi);
2258         for my $name ( keys %{$index_map} ) {
2259
2260             my $identifier = $qualifier_ids->{ $name };
2261
2262             next unless $identifier;
2263
2264             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2265             $set_node->setAttribute( identifier => $identifier );
2266             $set_node->setAttribute( name => $name );
2267
2268             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2269             for my $index ( sort keys %{$index_map->{$name}} ) {
2270                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2271
2272                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2273                 $map_node->appendChild( $name_node );
2274
2275                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2276
2277                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2278                 $index_node->appendChild( $title_node );
2279                 $index_node->appendChild( $map_node );
2280
2281                 $index_node->setAttribute( id => "$name.$index" );
2282                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2283                 $name_node->setAttribute( set => $name );
2284                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2285
2286                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2287             }
2288         }
2289
2290         $$explain = $e->toString;
2291     }
2292
2293     $resp->record(
2294         SRU::Response::Record->new(
2295             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2296             recordData      => $$explain
2297         )
2298     );
2299
2300 }
2301
2302 sub return_auth_response {
2303     my ($cgi, $req, $resp) = @_;
2304
2305     my $cql_query = decode_utf8($req->query);
2306     my $search = $req->cql->toEvergreenAuth;
2307
2308     my $qualifier = decode_utf8($search->{qualifier});
2309     my $term = decode_utf8($search->{term});
2310
2311     $log->info("SRU NAF search string [$cql_query] converted to "
2312         . "[$qualifier:$term]\n");
2313
2314     my $page_size = $req->maximumRecords;
2315     $page_size ||= 10;
2316
2317     # startwith deals with pages, so convert startRecord to a page number
2318     my $page = ($req->startRecord / $page_size) || 0;
2319
2320     my $recs;
2321     if ($qualifier eq "id") {
2322         $recs = [ int($term) ];
2323     } else {
2324         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2325
2326         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2327         $method .= ".refs" if $refs;
2328
2329         $recs = $supercat->request(
2330             $method,
2331             $realaxis,
2332             $term,
2333             $page,
2334             $page_size
2335         )->gather(1);
2336     }
2337
2338     my $record_position = $req->startRecord;
2339     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2340     foreach my $record (@$recs) {
2341         my $marcxml = $cstore->request(
2342             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2343         )->gather(1)->marc;
2344
2345         $resp->addRecord(
2346             SRU::Response::Record->new(
2347                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2348                 recordData => $marcxml,
2349                 recordPosition => ++$record_position
2350             )
2351         );
2352     }
2353
2354     $resp->numberOfRecords(scalar(@$recs));
2355 }
2356
2357 =head2 get_ou($org_unit)
2358
2359 Returns an aou object for a given actor.org_unit shortname or ID.
2360
2361 =cut
2362
2363 sub get_ou {
2364     my $org = shift || '-';
2365     my $org_unit;
2366
2367     if ($org eq '-') {
2368          $org_unit = $actor->request(
2369             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2370         )->gather(1);
2371     } elsif ($org !~ /^\d+$/o) {
2372          $org_unit = $actor->request(
2373             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2374         )->gather(1);
2375     } else {
2376          $org_unit = $actor->request(
2377             'open-ils.actor.org_unit_list.search' => id => $org
2378         )->gather(1);
2379     }
2380
2381     return $org_unit;
2382 }
2383
2384 1;
2385
2386 # vim: et:ts=4:sw=4