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          my $recs = $search->request(
1999             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
2000         )->gather(1);
2001
2002         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
2003
2004         foreach my $record (@$bre) {
2005             my $marcxml = $record->marc;
2006             # Make the beast conform to a VDX-supported format
2007             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
2008             # Trying to implement LIBSOL_852_A format; so much for standards
2009             if ($holdings) {
2010                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
2011                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
2012
2013                 # Force record leader to 'a' as our data is always UTF8
2014                 # Avoids marc8_to_utf8 from being invoked with horrible results
2015                 # on the off-chance the record leader isn't correct
2016                 my $ldr = $marc->leader;
2017                 substr($ldr, 9, 1, 'a');
2018                 $marc->leader($ldr);
2019
2020                 # Expects the record ID in the 001
2021                 $marc->delete_field($_) for ($marc->field('001'));
2022                 if (!$marc->field('001')) {
2023                     $marc->insert_fields_ordered(
2024                         MARC::Field->new( '001', $record->id )
2025                     );
2026                 }
2027                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
2028                 foreach my $cn (keys %$bib_holdings) {
2029                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
2030                         $marc->insert_fields_ordered(
2031                             MARC::Field->new(
2032                                 '852', '4', '',
2033                                 a => $cp->{'location'},
2034                                 b => $bib_holdings->{$cn}->{'owning_lib'},
2035                                 c => $cn,
2036                                 d => $cp->{'circlib'},
2037                                 g => $cp->{'barcode'},
2038                                 n => $cp->{'status'},
2039                             )
2040                         );
2041                     }
2042                 }
2043
2044                 $marcxml = $marc->as_xml_record();
2045                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2046
2047             }
2048             $resp->addRecord(
2049                 SRU::Response::Record->new(
2050                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2051                     recordData => $marcxml,
2052                     recordPosition => ++$offset
2053                 )
2054             );
2055         }
2056
2057         $resp->numberOfRecords($recs->{count});
2058
2059     } elsif ( $resp->type eq 'explain' ) {
2060         return_sru_explain($cgi, $req, $resp, \$ex_doc,
2061             undef,
2062             \%OpenILS::WWW::SuperCat::qualifier_ids
2063         );
2064
2065         $resp->record(
2066             SRU::Response::Record->new(
2067                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2068                 recordData        => $ex_doc
2069             )
2070         );
2071     }
2072
2073     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2074     print $U->entityize($resp->asXML) . "\n";
2075     return Apache2::Const::OK;
2076 }
2077
2078
2079 {
2080     package CQL::BooleanNode;
2081
2082     sub toEvergreen {
2083         my $self     = shift;
2084         my $left     = $self->left();
2085         my $right    = $self->right();
2086         my $leftStr  = $left->toEvergreen;
2087         my $rightStr = $right->toEvergreen();
2088
2089         my $op =  '||' if uc $self->op() eq 'OR';
2090         $op ||=  '&&';
2091
2092         return  "$leftStr $rightStr";
2093     }
2094
2095     sub toEvergreenAuth {
2096         return toEvergreen(shift);
2097     }
2098
2099     package CQL::TermNode;
2100
2101     sub toEvergreen {
2102         my $self      = shift;
2103         my $qualifier = $self->getQualifier();
2104         my $term      = $self->getTerm();
2105         my $relation  = $self->getRelation();
2106
2107         my $query;
2108         if ( $qualifier ) {
2109             my ($qset, $qname) = split(/\./, $qualifier);
2110
2111             # Per http://www.loc.gov/standards/sru/specs/cql.html
2112             # "All parts of CQL are case insensitive [...] If any case insensitive
2113             # part of CQL is specified with both upper and lower case, it is for
2114             # aesthetic purposes only."
2115
2116             # So fold the qualifier and relation to lower case
2117             $qset = lc($qset);
2118             $qname = lc($qname);
2119
2120             if ( exists($qualifier_map{$qset}{$qname}) ) {
2121                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2122                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
2123             }
2124
2125             my @modifiers = $relation->getModifiers();
2126
2127             my $base = $relation->getBase();
2128             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2129
2130                 my $quote_it = 1;
2131                 foreach my $m ( @modifiers ) {
2132                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2133                         $quote_it = 0;
2134                         last;
2135                     }
2136                 }
2137
2138                 $quote_it = 0 if ( $base eq 'all' );
2139                 $term = maybeQuote($term) if $quote_it;
2140
2141             } else {
2142                 croak( "Evergreen doesn't support the $base relations" );
2143             }
2144
2145
2146         } else {
2147             $qualifier = "kw";
2148         }
2149
2150         return "$qualifier:$term";
2151     }
2152
2153     sub toEvergreenAuth {
2154         my $self      = shift;
2155         my $qualifier = $self->getQualifier();
2156         my $term      = $self->getTerm();
2157         my $relation  = $self->getRelation();
2158
2159         my $query;
2160         if ( $qualifier ) {
2161             my ($qset, $qname) = split(/\./, $qualifier);
2162
2163             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2164                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2165                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2166             }
2167         }
2168         return { qualifier => $qualifier, term => $term };
2169     }
2170 }
2171
2172 my $auth_ex_doc;
2173 sub sru_auth_search {
2174     my $cgi = new CGI;
2175
2176     check_child_init();
2177
2178     my $req = SRU::Request->newFromCGI( $cgi );
2179     my $resp = SRU::Response->newFromRequest( $req );
2180
2181     if ( $resp->type eq 'searchRetrieve' ) {
2182         return_auth_response($cgi, $req, $resp);
2183     } elsif ( $resp->type eq 'explain' ) {
2184         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2185             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2186             \%OpenILS::WWW::SuperCat::qualifier_ids
2187         );
2188     }
2189
2190     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2191     print $U->entityize($resp->asXML) . "\n";
2192     return Apache2::Const::OK;
2193 }
2194
2195 sub explain_header {
2196     my $cgi = shift;
2197
2198     my $host = $cgi->virtual_host || $cgi->server_name;
2199
2200     my $add_path = 0;
2201     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2202         my $rel_name = $cgi->url(-relative=>1);
2203         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2204     }
2205     my $base = $cgi->url(-base=>1);
2206     my $url = $cgi->url(-path_info=>$add_path);
2207     $url =~ s/^$base\///o;
2208
2209     my $doc = $parser->parse_string($base_explain);
2210     my $e = $doc->documentElement;
2211     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2212     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2213     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2214
2215     return ($doc, $e);
2216 }
2217
2218 sub return_sru_explain {
2219     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2220
2221     $index_map ||= \%qualifier_map;
2222     if (!$$explain) {
2223         my ($doc, $e) = explain_header($cgi);
2224         for my $name ( keys %{$index_map} ) {
2225
2226             my $identifier = $qualifier_ids->{ $name };
2227
2228             next unless $identifier;
2229
2230             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2231             $set_node->setAttribute( identifier => $identifier );
2232             $set_node->setAttribute( name => $name );
2233
2234             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2235             for my $index ( sort keys %{$index_map->{$name}} ) {
2236                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2237
2238                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2239                 $map_node->appendChild( $name_node );
2240
2241                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2242
2243                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2244                 $index_node->appendChild( $title_node );
2245                 $index_node->appendChild( $map_node );
2246
2247                 $index_node->setAttribute( id => "$name.$index" );
2248                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2249                 $name_node->setAttribute( set => $name );
2250                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2251
2252                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2253             }
2254         }
2255
2256         $$explain = $e->toString;
2257     }
2258
2259     $resp->record(
2260         SRU::Response::Record->new(
2261             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2262             recordData      => $$explain
2263         )
2264     );
2265
2266 }
2267
2268 sub return_auth_response {
2269     my ($cgi, $req, $resp) = @_;
2270
2271     my $cql_query = decode_utf8($req->query);
2272     my $search = $req->cql->toEvergreenAuth;
2273
2274     my $qualifier = decode_utf8($search->{qualifier});
2275     my $term = decode_utf8($search->{term});
2276
2277     $log->info("SRU NAF search string [$cql_query] converted to "
2278         . "[$qualifier:$term]\n");
2279
2280     my $page_size = $req->maximumRecords;
2281     $page_size ||= 10;
2282
2283     # startwith deals with pages, so convert startRecord to a page number
2284     my $page = ($req->startRecord / $page_size) || 0;
2285
2286     my $recs;
2287     if ($qualifier eq "id") {
2288         $recs = [ int($term) ];
2289     } else {
2290         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2291
2292         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2293         $method .= ".refs" if $refs;
2294
2295         $recs = $supercat->request(
2296             $method,
2297             $realaxis,
2298             $term,
2299             $page,
2300             $page_size
2301         )->gather(1);
2302     }
2303
2304     my $record_position = $req->startRecord;
2305     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2306     foreach my $record (@$recs) {
2307         my $marcxml = $cstore->request(
2308             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2309         )->gather(1)->marc;
2310
2311         $resp->addRecord(
2312             SRU::Response::Record->new(
2313                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2314                 recordData => $marcxml,
2315                 recordPosition => ++$record_position
2316             )
2317         );
2318     }
2319
2320     $resp->numberOfRecords(scalar(@$recs));
2321 }
2322
2323 =head2 get_ou($org_unit)
2324
2325 Returns an aou object for a given actor.org_unit shortname or ID.
2326
2327 =cut
2328
2329 sub get_ou {
2330     my $org = shift || '-';
2331     my $org_unit;
2332
2333     if ($org eq '-') {
2334          $org_unit = $actor->request(
2335             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2336         )->gather(1);
2337     } elsif ($org !~ /^\d+$/o) {
2338          $org_unit = $actor->request(
2339             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2340         )->gather(1);
2341     } else {
2342          $org_unit = $actor->request(
2343             'open-ils.actor.org_unit_list.search' => id => $org
2344         )->gather(1);
2345     }
2346
2347     return $org_unit;
2348 }
2349
2350 1;
2351
2352 # vim: et:ts=4:sw=4