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 $supercat
 462         ->request("open-ils.supercat.u2", $u2->toURI, $format)
 463         ->gather(1);
 464
 465     return Apache2::Const::OK;
 466 }
 467
 468 sub unapi {
 469
 470     my $apache = shift;
 471     return Apache2::Const::DECLINED if (-e $apache->filename);
 472
 473     check_child_init();
 474
 475     my $cgi = new CGI;
 476
 477     my $add_path = 0;
 478     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 479         my $rel_name = $cgi->url(-relative=>1);
 480         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 481     }
 482
 483     my $url = $cgi->url(-path_info=>$add_path);
 484     my $root = (split 'unapi', $url)[0];
 485     my $base = (split 'unapi', $url)[0] . 'unapi';
 486
 487
 488     my $uri = $cgi->param('id') || '';
 489
 490     my $format = $cgi->param('format') || '';
 491     (my $base_format = $format) =~ s/(-full|-uris)$//o;
 492     my $u2uri = OpenILS::Utils::TagURI->new($uri);
 493     if ($format and $u2uri->version > 1) {
 494         return unapi2($apache, $u2uri, $format);
 495     }
 496
 497     my $host = $cgi->virtual_host || $cgi->server_name;
 498
 499     my $skin = $cgi->param('skin') || 'default';
 500     my $locale = $cgi->param('locale') || 'en-US';
 501
 502     # Enable localized results of copy status, etc
 503     $supercat->session_locale($locale);
 504
 505     my $flesh_feed = parse_feed_type($format);
 506     (my $base_format = $format) =~ s/(-full|-uris)$//o;
 507     my ($id,$type,$command,$lib,$depth,$paging) = ('','record','');
 508     my $body = "Content-type: application/xml; charset=utf-8\n\n";
 509
 510     if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
 511         $id = $2;
 512         $paging = $3;
 513         ($lib,$depth) = split('/', $4);
 514         $type = 'metarecord' if ($1 =~ /^m/o);
 515         $type = 'authority' if ($1 =~ /^authority/o);
 516     }
 517
 518     if (!$format) {
 519         if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
 520
 521             my $list = $supercat
 522                 ->request("open-ils.supercat.$type.formats")
 523                 ->gather(1);
 524
 525             if ($type eq 'record' or $type eq 'isbn') {
 526                 $body .= <<"                FORMATS";
 527 <formats id='$uri'>
 528     <format name='opac' type='text/html'/>
 529     <format name='html' type='text/html'/>
 530     <format name='htmlholdings' type='text/html'/>
 531     <format name='holdings_xml' type='application/xml'/>
 532     <format name='holdings_xml-full' type='application/xml'/>
 533     <format name='html-full' type='text/html'/>
 534     <format name='htmlholdings-full' type='text/html'/>
 535     <format name='marctxt' type='text/plain'/>
 536     <format name='ris' type='text/plain'/>
 537                 FORMATS
 538             } elsif ($type eq 'metarecord') {
 539                 $body .= <<"                FORMATS";
 540                 <formats id='$uri'>
 541                     <format name='opac' type='text/html'/>
 542                 FORMATS
 543             } else {
 544                 $body .= <<"                FORMATS";
 545                 <formats id='$uri'>
 546                 FORMATS
 547             }
 548
 549             for my $h (@$list) {
 550                 my ($type) = keys %$h;
 551                 $body .= unapi_format($h, $type);
 552
 553                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 554                     $body .= unapi_format($h, "$type-full");
 555                     $body .= unapi_format($h, "$type-uris");
 556                 }
 557             }
 558
 559             $body .= "</formats>\n";
 560
 561         } else {
 562             my $list = $supercat
 563                 ->request("open-ils.supercat.$type.formats")
 564                 ->gather(1);
 565
 566             push @$list,
 567                 @{ $supercat
 568                     ->request("open-ils.supercat.metarecord.formats")
 569                     ->gather(1);
 570                 };
 571
 572             my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 573             $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 574
 575             $body .= <<"            FORMATS";
 576 <formats>
 577     <format name='opac' type='text/html'/>
 578     <format name='html' type='text/html'/>
 579     <format name='htmlholdings' type='text/html'/>
 580     <format name='holdings_xml' type='application/xml'/>
 581     <format name='holdings_xml-full' type='application/xml'/>
 582     <format name='html-full' type='text/html'/>
 583     <format name='htmlholdings-full' type='text/html'/>
 584     <format name='marctxt' type='text/plain'/>
 585     <format name='ris' type='text/plain'/>
 586             FORMATS
 587
 588
 589             for my $h (@$list) {
 590                 my ($type) = keys %$h;
 591                 $body .= "\t" . unapi_format($h, $type);
 592
 593                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 594                     $body .= "\t" . unapi_format($h, "$type-full");
 595                     $body .= "\t" . unapi_format($h, "$type-uris");
 596                 }
 597             }
 598
 599             $body .= "</formats>\n";
 600
 601         }
 602         print $body;
 603         return Apache2::Const::OK;
 604     }
 605
 606     my $scheme;
 607     if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
 608         $scheme = $1;
 609         $id = $2;
 610         $paging = $3;
 611         ($lib,$depth) = split('/', $4);
 612         $type = 'record';
 613         $type = 'metarecord' if ($scheme =~ /^metabib/o);
 614         $type = 'isbn' if ($scheme =~ /^isbn/o);
 615         $type = 'acp' if ($scheme =~ /^asset-copy/o);
 616         $type = 'acn' if ($scheme =~ /^asset-call_number/o);
 617         $type = 'auri' if ($scheme =~ /^asset-uri/o);
 618         $type = 'authority' if ($scheme =~ /^authority/o);
 619         $command = 'retrieve';
 620         $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
 621         $command = 'browse' if ($scheme =~ /^authority/);
 622     }
 623
 624     if ($paging) {
 625         $paging = [split ',', $paging];
 626     } else {
 627         $paging = [];
 628     }
 629
 630     if (!$lib || $lib eq '-') {
 631          $lib = $actor->request(
 632             'open-ils.actor.org_unit_list.search' => parent_ou => undef
 633         )->gather(1)->[0]->shortname;
 634     }
 635
 636     my ($lib_object,$lib_id,$ou_types,$lib_depth);
 637     if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
 638         $lib_object = $actor->request(
 639             'open-ils.actor.org_unit_list.search' => shortname => $lib
 640         )->gather(1)->[0];
 641         $lib_id = $lib_object->id;
 642
 643         $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
 644         $lib_depth = defined($depth) ? $depth : (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
 645     }
 646
 647     if ($command eq 'browse') {
 648         print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
 649         return 302;
 650     }
 651
 652     if ($type eq 'isbn') {
 653         my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
 654         if (!@$rec) {
 655             # Escape user input before display
 656             $command = CGI::escapeHTML($command);
 657             $id = CGI::escapeHTML($id);
 658             $type = CGI::escapeHTML($type);
 659             $format = CGI::escapeHTML(decode_utf8($format));
 660
 661             print "Content-type: text/html; charset=utf-8\n\n";
 662             $apache->custom_response( 404, <<"            HTML");
 663             <html>
 664                 <head>
 665                     <title>Type [$type] with id [$id] not found!</title>
 666                 </head>
 667                 <body>
 668                     <br/>
 669                     <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 670                 </body>
 671             </html>
 672             HTML
 673             return 404;
 674         }
 675         $id = $rec->[0]->id;
 676         $type = 'record';
 677     }
 678
 679     if ( !grep
 680            { (keys(%$_))[0] eq $base_format }
 681            @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
 682          and !grep
 683            { $_ eq $base_format }
 684            qw/opac html htmlholdings marctxt ris holdings_xml/
 685     ) {
 686         # Escape user input before display
 687         $format = CGI::escapeHTML($format);
 688         $type = CGI::escapeHTML($type);
 689
 690         print "Content-type: text/html; charset=utf-8\n\n";
 691         $apache->custom_response( 406, <<"        HTML");
 692         <html>
 693             <head>
 694                 <title>Invalid format [$format] for type [$type]!</title>
 695             </head>
 696             <body>
 697                 <br/>
 698                 <center>Sorry, format $format is not valid for type $type.</center>
 699             </body>
 700         </html>
 701         HTML
 702         return 406;
 703     }
 704
 705     if ($format eq 'opac') {
 706         print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
 707             if ($type eq 'metarecord');
 708         print "Location: /eg/opac/record/$id?locg=$lib_id&depth=$lib_depth\n\n"
 709             if ($type eq 'record');
 710         return 302;
 711     } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
 712         my $feed = create_record_feed(
 713             $type,
 714             $format => [ $id ],
 715             $base,
 716             $lib,
 717             $depth,
 718             $flesh_feed,
 719             $paging
 720         );
 721
 722         if (!$feed->count) {
 723             # Escape user input before display
 724             $command = CGI::escapeHTML($command);
 725             $id = CGI::escapeHTML($id);
 726             $type = CGI::escapeHTML($type);
 727             $format = CGI::escapeHTML(decode_utf8($format));
 728
 729             print "Content-type: text/html; charset=utf-8\n\n";
 730             $apache->custom_response( 404, <<"            HTML");
 731             <html>
 732                 <head>
 733                     <title>Type [$type] with id [$id] not found!</title>
 734                 </head>
 735                 <body>
 736                     <br/>
 737                     <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 738                 </body>
 739             </html>
 740             HTML
 741             return 404;
 742         }
 743
 744         $feed->root($root);
 745         $feed->creator($host);
 746         $feed->update_ts();
 747         $feed->link( unapi => $base) if ($flesh_feed);
 748
 749         print "Content-type: ". $feed->type ."; charset=utf-8\n";
 750
 751         print $_ for extra_headers_per_type_to_string($type);
 752
 753         print "\n", $feed->toString, "\n";
 754
 755         return Apache2::Const::OK;
 756     }
 757
 758     my $method = "open-ils.supercat.$type.$base_format.$command";
 759     my @params = ($id);
 760     push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
 761
 762     # for acn, acp, etc, the "lib" pathinfo position isn't useful.
 763     # however, we can have it carry extra options like no_record! (comma separated)
 764     push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
 765
 766     my $req = $supercat->request($method,@params);
 767     my $data = $req->gather();
 768
 769     if ($req->failed || !$data) {
 770         # Escape user input before display
 771         $command = CGI::escapeHTML($command);
 772         $id = CGI::escapeHTML($id);
 773         $type = CGI::escapeHTML($type);
 774         $format = CGI::escapeHTML(decode_utf8($format));
 775
 776         print "Content-type: text/html; charset=utf-8\n\n";
 777         $apache->custom_response( 404, <<"        HTML");
 778         <html>
 779             <head>
 780                 <title>$type $id not found!</title>
 781             </head>
 782             <body>
 783                 <br/>
 784                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 785             </body>
 786         </html>
 787         HTML
 788         return 404;
 789     }
 790
 791     print "Content-type: application/xml; charset=utf-8\n\n";
 792
 793     # holdings_xml format comes back to us without an XML declaration
 794     # and without being entityized; fix that here
 795     if ($base_format eq 'holdings_xml') {
 796         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
 797         print $U->entityize($data);
 798
 799         while (my $c = $req->recv) {
 800             print $U->entityize($c->content);
 801         }
 802     } else {
 803         print $data;
 804     }
 805
 806     return Apache2::Const::OK;
 807 }
 808
 809 sub supercat {
 810
 811     my $apache = shift;
 812     return Apache2::Const::DECLINED if (-e $apache->filename);
 813
 814     check_child_init();
 815
 816     my $cgi = new CGI;
 817
 818     my $add_path = 0;
 819     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 820         my $rel_name = $cgi->url(-relative=>1);
 821         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 822     }
 823
 824     my $url = $cgi->url(-path_info=>$add_path);
 825     my $root = (split 'supercat', $url)[0];
 826     my $base = (split 'supercat', $url)[0] . 'supercat';
 827     my $unapi = (split 'supercat', $url)[0] . 'unapi';
 828
 829     my $host = $cgi->virtual_host || $cgi->server_name;
 830
 831     my $path = $cgi->path_info;
 832     my ($id,$type,$format,$command) = reverse split '/', $path;
 833     my $flesh_feed = parse_feed_type($format);
 834     (my $base_format = $format) =~ s/(-full|-uris)$//o;
 835
 836     my $skin = $cgi->param('skin') || 'default';
 837     my $locale = $cgi->param('locale') || 'en-US';
 838
 839     # Enable localized results of copy status, etc
 840     $supercat->session_locale($locale);
 841
 842     if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 843         print "Content-type: application/xml; charset=utf-8\n";
 844         if ($1) {
 845             my $list = $supercat
 846                 ->request("open-ils.supercat.$1.formats")
 847                 ->gather(1);
 848
 849             print "\n";
 850
 851             print "<formats>
 852                    <format>
 853                      <name>opac</name>
 854                      <type>text/html</type>
 855                    </format>";
 856
 857             if ($1 eq 'record' or $1 eq 'isbn') {
 858                 print "<format>
 859                      <name>htmlholdings</name>
 860                      <type>text/html</type>
 861                    </format>
 862                    <format>
 863                      <name>html</name>
 864                      <type>text/html</type>
 865                    </format>
 866                    <format>
 867                      <name>htmlholdings-full</name>
 868                      <type>text/html</type>
 869                    </format>
 870                    <format>
 871                      <name>html-full</name>
 872                      <type>text/html</type>
 873                    </format>
 874                    <format>
 875                      <name>marctxt</name>
 876                      <type>text/plain</type>
 877                    </format>
 878                    <format>
 879                      <name>ris</name>
 880                      <type>text/plain</type>
 881                    </format>";
 882             }
 883
 884             for my $h (@$list) {
 885                 my ($type) = keys %$h;
 886                 print supercat_format($h, $type);
 887
 888                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 889                     print supercat_format($h, "$type-full");
 890                     print supercat_format($h, "$type-uris");
 891                 }
 892
 893             }
 894
 895             print "</formats>\n";
 896
 897             return Apache2::Const::OK;
 898         }
 899
 900         my $list = $supercat
 901             ->request("open-ils.supercat.record.formats")
 902             ->gather(1);
 903
 904         push @$list,
 905             @{ $supercat
 906                 ->request("open-ils.supercat.metarecord.formats")
 907                 ->gather(1);
 908             };
 909
 910         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 911         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 912
 913         print "\n<formats>
 914                <format>
 915                  <name>opac</name>
 916                  <type>text/html</type>
 917                </format>
 918                <format>
 919                  <name>htmlholdings</name>
 920                  <type>text/html</type>
 921                </format>
 922                <format>
 923                  <name>html</name>
 924                  <type>text/html</type>
 925                </format>
 926                <format>
 927                  <name>htmlholdings-full</name>
 928                  <type>text/html</type>
 929                </format>
 930                <format>
 931                  <name>html-full</name>
 932                  <type>text/html</type>
 933                </format>
 934                <format>
 935                  <name>marctxt</name>
 936                  <type>text/plain</type>
 937                </format>
 938                <format>
 939                  <name>ris</name>
 940                  <type>text/plain</type>
 941                </format>";
 942
 943         for my $h (@$list) {
 944             my ($type) = keys %$h;
 945             print supercat_format($h, $type);
 946
 947             if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 948                 print supercat_format($h, "$type-full");
 949                 print supercat_format($h, "$type-uris");
 950             }
 951
 952         }
 953
 954         print "</formats>\n";
 955
 956
 957         return Apache2::Const::OK;
 958     }
 959
 960     if ($format eq 'opac') {
 961         print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
 962             if ($type eq 'metarecord');
 963         print "Location: /eg/opac/record/$id\n\n"
 964             if ($type eq 'record');
 965         return 302;
 966
 967     } elsif ($base_format eq 'marc21') {
 968
 969         my $ret = 200;
 970         try {
 971             my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
 972
 973             print "Content-type: application/octet-stream\n";
 974             print $_ for extra_headers_per_type_to_string($base_format);
 975             print "\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
 976
 977         } otherwise {
 978             warn shift();
 979
 980             # Escape user input before display
 981             $id = CGI::escapeHTML($id);
 982
 983             print "Content-type: text/html; charset=utf-8\n\n";
 984             $apache->custom_response( 404, <<"            HTML");
 985             <html>
 986                 <head>
 987                     <title>ERROR</title>
 988                 </head>
 989                 <body>
 990                     <br/>
 991                     <center>Couldn't fetch $id as MARC21.</center>
 992                 </body>
 993             </html>
 994             HTML
 995             $ret = 404;
 996         };
 997
 998         return Apache2::Const::OK;
 999
1000     } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
1001         my $feed = create_record_feed(
1002             $type,
1003             $format => [ $id ],
1004             undef, undef, undef,
1005             $flesh_feed
1006         );
1007
1008         $feed->root($root);
1009         $feed->creator($host);
1010
1011         $feed->update_ts();
1012
1013         $feed->link( unapi => $base) if ($flesh_feed);
1014
1015         print "Content-type: ". $feed->type ."; charset=utf-8\n";
1016
1017         print $_ for extra_headers_per_type_to_string($type);
1018
1019         print "\n", $feed->toString, "\n";
1020
1021         return Apache2::Const::OK;
1022     }
1023
1024     my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
1025     $req->wait_complete;
1026
1027     if ($req->failed) {
1028         # Escape user input before display
1029         $command = CGI::escapeHTML($command);
1030         $id = CGI::escapeHTML($id);
1031         $type = CGI::escapeHTML($type);
1032         $format = CGI::escapeHTML(decode_utf8($format));
1033
1034         print "Content-type: text/html; charset=utf-8\n\n";
1035         $apache->custom_response( 404, <<"        HTML");
1036         <html>
1037             <head>
1038                 <title>$type $id not found!</title>
1039             </head>
1040             <body>
1041                 <br/>
1042                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
1043             </body>
1044         </html>
1045         HTML
1046         return 404;
1047     }
1048
1049     print "Content-type: application/xml; charset=utf-8\n\n";
1050     print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
1051
1052     return Apache2::Const::OK;
1053 }
1054
1055
1056 sub bookbag_feed {
1057     my $apache = shift;
1058     return Apache2::Const::DECLINED if (-e $apache->filename);
1059
1060     check_child_init();
1061
1062     my $cgi = new CGI;
1063
1064     my $year = (gmtime())[5] + 1900;
1065     my $host = $cgi->virtual_host || $cgi->server_name;
1066
1067     my $add_path = 0;
1068     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1069         my $rel_name = $cgi->url(-relative=>1);
1070         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1071     }
1072
1073     my $url = $cgi->url(-path_info=>$add_path);
1074     my $root = (split 'feed', $url)[0] . '/';
1075     my $base = (split 'bookbag', $url)[0] . '/bookbag';
1076     my $unapi = (split 'feed', $url)[0] . '/unapi';
1077
1078     my $skin = $cgi->param('skin') || 'default';
1079     my $locale = $cgi->param('locale') || 'en-US';
1080     my $org = $cgi->param('searchOrg');
1081
1082     # Enable localized results of copy status, etc
1083     $supercat->session_locale($locale);
1084
1085     my $org_unit = get_ou($org);
1086     my $scope = "l=" . $org_unit->[0]->id . "&";
1087
1088     $root =~ s{(?<!http:)//}{//}go;
1089     $base =~ s{(?<!http:)//}{//}go;
1090     $unapi =~ s{(?<!http:)//}{//}go;
1091
1092     my $path = $cgi->path_info;
1093     #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
1094
1095     my ($id,$type) = reverse split '/', $path;
1096     my $flesh_feed = parse_feed_type($type);
1097
1098     my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
1099     return Apache2::Const::NOT_FOUND unless($bucket);
1100
1101     my $bucket_tag = "tag:$host,$year:record_bucket/$id";
1102     if (lc($type) eq 'opac') {
1103         print "Location: /eg/opac/results?bookbag=$id\n\n";
1104         return 302;
1105     }
1106
1107     # last created first
1108     my @sorted_bucket_items = sort { $b->create_time cmp $a->create_time } @{ $bucket->items };
1109
1110     my $feed = create_record_feed(
1111         'record',
1112         $type,
1113         [ map { $_->target_biblio_record_entry } @sorted_bucket_items ],
1114         $unapi,
1115         $org_unit->[0]->shortname,
1116         undef,
1117         $flesh_feed
1118     );
1119     $feed->root($root);
1120     $feed->id($bucket_tag);
1121
1122     $feed->title($bucket->name);
1123     $feed->description($bucket->description || ("Items in Book Bag [".$bucket->name."]"));
1124     $feed->creator($host);
1125     $feed->update_ts();
1126
1127     $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
1128     $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
1129     $feed->link(opac => $base . "/opac/$id" => 'text/html');
1130     $feed->link(OPAC => $base . "/opac/$id" => 'text/html');
1131     $feed->link(html => $base . "/html-full/$id" => 'text/html');
1132     $feed->link(unapi => $unapi);
1133
1134     print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1135     print $feed->toString . "\n";
1136
1137     return Apache2::Const::OK;
1138 }
1139
1140 sub changes_feed {
1141     my $apache = shift;
1142     return Apache2::Const::DECLINED if (-e $apache->filename);
1143
1144     check_child_init();
1145
1146     my $cgi = new CGI;
1147
1148     my $year = (gmtime())[5] + 1900;
1149     my $host = $cgi->virtual_host || $cgi->server_name;
1150
1151     my $add_path = 0;
1152     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1153         my $rel_name = $cgi->url(-relative=>1);
1154         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1155     }
1156
1157     my $url = $cgi->url(-path_info=>$add_path);
1158     my $root = (split 'feed', $url)[0];
1159     my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
1160     my $unapi = (split 'feed', $url)[0] . 'unapi';
1161
1162     my $skin = $cgi->param('skin') || 'default';
1163     my $locale = $cgi->param('locale') || 'en-US';
1164     my $org = $cgi->param('searchOrg');
1165
1166     # Enable localized results of copy status, etc
1167     $supercat->session_locale($locale);
1168
1169     my $org_unit = get_ou($org);
1170     my $scope = "l=" . $org_unit->[0]->id . "&";
1171
1172     my $path = $cgi->path_info;
1173     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1174
1175     $path =~ s/^\/(?:feed\/)?freshmeat\///og;
1176
1177     my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
1178     my $flesh_feed = parse_feed_type($type);
1179
1180     $limit ||= 10;
1181     $limit = 10 if $limit !~ /^\d+$/;
1182
1183     my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
1184
1185     if (lc($type) eq 'opac') {
1186         print "Location: /eg/opac/results?query=record_list(".join(',', @$list ).")+sort(edit_date)+\%23descending&locg=".$org_unit->[0]->id . "\n\n";
1187         return 302;
1188     }
1189
1190     my $search = 'record';
1191     if ($rtype eq 'authority') {
1192         $search = 'authority';
1193     }
1194     my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1195     $feed->root($root);
1196
1197     if ($date) {
1198         $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1199     } else {
1200         $feed->title("$limit most recent $rtype ${axis}s");
1201     }
1202
1203     $feed->creator($host);
1204     $feed->update_ts();
1205
1206     $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1207     $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1208     $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1209     $feed->link(unapi => $unapi);
1210
1211     $feed->link(
1212         OPAC =>
1213         "http://$host/eg/opac/results?query=record_list(".join(',', @$list ).")\%20sort(edit_date)#descending&locg=".$org_unit->[0]->id,
1214         'text/html'
1215     );
1216
1217
1218     print "Content-type: ". $feed->type ."; charset=utf-8\n";
1219
1220     print $_ for extra_headers_per_type_to_string($type);
1221
1222     print "\n", $feed->toString, "\n";
1223
1224     return Apache2::Const::OK;
1225 }
1226
1227 sub opensearch_osd {
1228     my $version = shift;
1229     my $lib = shift;
1230     my $class = shift;
1231     my $base = shift;
1232     my $host = shift;
1233
1234     if ($version eq '1.0') {
1235         print <<OSD;
1236 Content-type: application/opensearchdescription+xml; charset=utf-8
1237
1238 <?xml version="1.0" encoding="UTF-8"?>
1239 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1240   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&amp;startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
1241   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1242   <ShortName>$lib</ShortName>
1243   <LongName>Search $lib</LongName>
1244   <Description>Search the $lib OPAC by $class.</Description>
1245   <Tags>$lib book library</Tags>
1246   <SampleSearch>harry+potter</SampleSearch>
1247   <Developer>Mike Rylander for GPLS/PINES</Developer>
1248   <Contact>feedback\@open-ils.org</Contact>
1249   <SyndicationRight>open</SyndicationRight>
1250   <AdultContent>false</AdultContent>
1251 </OpenSearchDescription>
1252 OSD
1253     } else {
1254         print <<OSD;
1255 Content-type: application/opensearchdescription+xml; charset=utf-8
1256
1257 <?xml version="1.0" encoding="UTF-8"?>
1258 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1259   <ShortName>$lib</ShortName>
1260   <Description>Search the $lib OPAC by $class.</Description>
1261   <Tags>$lib book library</Tags>
1262   <Url type="application/rss+xml"
1263        template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1264   <Url type="application/atom+xml"
1265        template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1266   <Url type="application/x-mods3+xml"
1267        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1268   <Url type="application/x-mods+xml"
1269        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1270   <Url type="application/octet-stream"
1271        template="$base/1.1/$lib/marc21/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1272   <Url type="application/x-marcxml+xml"
1273        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1274   <Url type="text/html"
1275        template="https://$host/eg/opac/results?locg=$lib;query={searchTerms};page={startPage?};startIndex={startIndex?};count={count?};searchLang={language?}"/>
1276   <LongName>Search $lib</LongName>
1277   <Query role="example" searchTerms="harry+potter" />
1278   <Developer>Mike Rylander for GPLS/PINES</Developer>
1279   <Contact>feedback\@open-ils.org</Contact>
1280   <SyndicationRight>open</SyndicationRight>
1281   <AdultContent>false</AdultContent>
1282   <Language>en-US</Language>
1283   <OutputEncoding>UTF-8</OutputEncoding>
1284   <InputEncoding>UTF-8</InputEncoding>
1285 </OpenSearchDescription>
1286 OSD
1287     }
1288
1289     return Apache2::Const::OK;
1290 }
1291
1292 sub opensearch_feed {
1293     my $apache = shift;
1294     return Apache2::Const::DECLINED if (-e $apache->filename);
1295
1296     check_child_init();
1297
1298     my $cgi = new CGI;
1299     my $year = (gmtime())[5] + 1900;
1300
1301     my $host = $cgi->virtual_host || $cgi->server_name;
1302
1303     my $add_path = 0;
1304     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1305         my $rel_name = $cgi->url(-relative=>1);
1306         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1307     }
1308
1309     my $url = $cgi->url(-path_info=>$add_path);
1310     my $root = (split 'opensearch', $url)[0];
1311     my $base = (split 'opensearch', $url)[0] . 'opensearch';
1312     my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1313
1314     my $path = $cgi->path_info;
1315     #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1316
1317     if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1318
1319         my $version = $1;
1320         my $lib = uc($2);
1321         my $class = $3;
1322
1323         if (!$lib || $lib eq '-') {
1324              $lib = $actor->request(
1325                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1326             )->gather(1)->[0]->shortname;
1327         }
1328
1329         if ($class eq '-') {
1330             $class = 'keyword';
1331         }
1332
1333         return opensearch_osd($version, $lib, $class, $base, $host);
1334     }
1335
1336
1337     my $page = $cgi->param('startPage') || 1;
1338     my $offset = $cgi->param('startIndex') || 1;
1339     my $limit = $cgi->param('count') || 10;
1340
1341     $page = 1 if ($page !~ /^\d+$/);
1342     $offset = 1 if ($offset !~ /^\d+$/);
1343     $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1344
1345     if ($page > 1) {
1346         $offset = ($page - 1) * $limit;
1347     } else {
1348         $offset -= 1;
1349     }
1350
1351     my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1352     (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1353
1354     $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1355     $lang = '' if ($lang eq '*');
1356
1357     $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1358     $sort ||= '';
1359     $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1360     $sortdir ||= '';
1361
1362     $terms .= " " if ($terms && $cgi->param('searchTerms'));
1363     $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1364
1365     $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1366     $class ||= '-';
1367
1368     $type = $cgi->param('responseType') if $cgi->param('responseType');
1369     $type ||= '-';
1370
1371     $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1372     $org ||= '-';
1373
1374
1375     my $kwt = $cgi->param('kw');
1376     my $tit = $cgi->param('ti');
1377     my $aut = $cgi->param('au');
1378     my $sut = $cgi->param('su');
1379     my $set = $cgi->param('se');
1380
1381     $terms .= " " if ($terms && $kwt);
1382     $terms .= "keyword: $kwt" if ($kwt);
1383     $terms .= " " if ($terms && $tit);
1384     $terms .= "title: $tit" if ($tit);
1385     $terms .= " " if ($terms && $aut);
1386     $terms .= "author: $aut" if ($aut);
1387     $terms .= " " if ($terms && $sut);
1388     $terms .= "subject: $sut" if ($sut);
1389     $terms .= " " if ($terms && $set);
1390     $terms .= "series: $set" if ($set);
1391
1392     if ($version eq '1.0') {
1393         $type = 'rss2';
1394     } elsif ($type eq '-') {
1395         $type = 'atom';
1396     }
1397     my $flesh_feed = parse_feed_type($type);
1398
1399     $terms = decode_utf8($terms);
1400     $lang = 'eng' if ($lang eq 'en-US');
1401
1402     $log->debug("OpenSearch terms: $terms");
1403
1404     my $org_unit = get_ou($org);
1405
1406     # Apostrophes break search and get indexed as spaces anyway
1407     my $safe_terms = $terms;
1408     $safe_terms =~ s{'}{ }go;
1409
1410     my $recs = $search->request(
1411         'open-ils.search.biblio.multiclass.query' => {
1412             org_unit    => $org_unit->[0]->id,
1413             offset        => $offset,
1414             limit        => $limit,
1415             sort        => $sort,
1416             sort_dir    => $sortdir,
1417             default_class => $class,
1418             ($lang ?    ( 'language' => $lang    ) : ()),
1419         } => $safe_terms => 1
1420     )->gather(1);
1421
1422     $log->debug("Hits for [$terms]: $recs->{count}");
1423
1424     my $feed = create_record_feed(
1425         'record',
1426         $type,
1427         [ map { $_->[0] } @{$recs->{ids}} ],
1428         $unapi,
1429         $org,
1430         undef,
1431         $flesh_feed
1432     );
1433
1434     $log->debug("Feed created...");
1435
1436     $feed->root($root);
1437     $feed->lib($org);
1438     $feed->search($safe_terms);
1439     $feed->class($class);
1440
1441     $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1442
1443     $feed->creator($host);
1444     $feed->update_ts();
1445
1446     $feed->_create_node(
1447         $feed->{item_xpath},
1448         'http://a9.com/-/spec/opensearch/1.1/',
1449         'totalResults',
1450         $recs->{count},
1451     );
1452
1453     $feed->_create_node(
1454         $feed->{item_xpath},
1455         'http://a9.com/-/spec/opensearch/1.1/',
1456         'startIndex',
1457         $offset + 1,
1458     );
1459
1460     $feed->_create_node(
1461         $feed->{item_xpath},
1462         'http://a9.com/-/spec/opensearch/1.1/',
1463         'itemsPerPage',
1464         $limit,
1465     );
1466
1467     $log->debug("...basic feed data added...");
1468
1469     $feed->link(
1470         next =>
1471         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1472         'application/opensearch+xml'
1473     ) if ($offset + $limit < $recs->{count});
1474
1475     $feed->link(
1476         previous =>
1477         $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1478         'application/opensearch+xml'
1479     ) if ($offset);
1480
1481     $feed->link(
1482         self =>
1483         $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1484         'application/opensearch+xml'
1485     );
1486
1487     $feed->link(
1488         alternate =>
1489         $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1490         'application/rss+xml'
1491     );
1492
1493     $feed->link(
1494         atom =>
1495         $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1496         'application/atom+xml'
1497     );
1498
1499     $feed->link(
1500         'html' =>
1501         $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1502         'text/html'
1503     );
1504
1505     $feed->link(
1506         'html-full' =>
1507         $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1508         'text/html'
1509     );
1510
1511     $feed->link( 'unapi-server' => $unapi);
1512
1513     $log->debug("...feed links added...");
1514
1515 #    $feed->link(
1516 #        opac =>
1517 #        $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1518 #            join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1519 #        'text/html'
1520 #    );
1521
1522     #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1523     print $cgi->header(
1524         -type => $feed->type, -charset => 'UTF-8',
1525         extra_headers_per_type_to_cgi($type)
1526     ), $feed->toString, "\n";
1527
1528     $log->debug("...and feed returned.");
1529
1530     return Apache2::Const::OK;
1531 }
1532
1533 sub create_record_feed {
1534     my $search = shift;
1535     my $type = shift;
1536     my $records = shift;
1537     my $unapi = shift;
1538
1539     my $lib = uc(shift()) || '-';
1540     my $depth = shift;
1541     my $flesh = shift;
1542
1543     my $paging = shift;
1544
1545     my $cgi = new CGI;
1546     my $base = $cgi->url;
1547     my $host = $cgi->virtual_host || $cgi->server_name;
1548
1549     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1550     $year += 1900;
1551     $month += 1;
1552
1553     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1554
1555     my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1556
1557     $type =~ s/(-full|-uris)$//o;
1558
1559     my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1560     $feed->base($base) if ($flesh);
1561     $feed->unapi($unapi) if ($flesh);
1562
1563     $type = 'atom' if ($type eq 'html');
1564     $type = 'marcxml' if
1565         $type eq 'htmlholdings' or
1566         $type eq 'marctxt' or
1567         $type eq 'ris' or
1568         $type eq 'marc21';  # kludgy since it isn't an XML format, but needed
1569
1570     #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1571
1572     my $count = 0;
1573     for my $record (@$records) {
1574         next unless($record);
1575
1576         #my $rec = $record->id;
1577         my $rec = $record;
1578
1579         my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1580         $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1581         $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1582         $item_tag .= "/$depth" if (defined($depth));
1583
1584         $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1585
1586         my $xml = $supercat->request(
1587             "open-ils.supercat.$search.$type.retrieve",
1588             $rec
1589         )->gather(1);
1590         next unless $xml;
1591
1592         my $node = $feed->add_item($xml);
1593         next unless $node;
1594
1595         $xml = '';
1596         if ($lib && ($type eq 'marcxml' || $type eq 'atom') && ($flesh > 0)) {
1597             my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1598             while ( !$r->complete ) {
1599                 $xml .= join('', map {$_->content} $r->recv);
1600             }
1601             $xml .= join('', map {$_->content} $r->recv);
1602             $node->add_holdings($xml);
1603         }
1604
1605         $node->id($item_tag);
1606         #$node->update_ts(cleanse_ISO8601($record->edit_date));
1607         $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html') if ($flesh > 0);
1608         $node->link(slimpac => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1609         $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1610         $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1611         $node->link('unapi-id' => $item_tag) if ($flesh);
1612     }
1613
1614     return $feed;
1615 }
1616
1617 sub string_browse {
1618     my $apache = shift;
1619     return Apache2::Const::DECLINED if (-e $apache->filename);
1620
1621     check_child_init();
1622
1623     my $cgi = new CGI;
1624     my $year = (gmtime())[5] + 1900;
1625
1626     my $host = $cgi->virtual_host || $cgi->server_name;
1627
1628     my $add_path = 0;
1629     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1630         my $rel_name = $cgi->url(-relative=>1);
1631         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1632     }
1633
1634     my $url = $cgi->url(-path_info=>$add_path);
1635     my $root = (split 'browse', $url)[0];
1636     my $base = (split 'browse', $url)[0] . 'browse';
1637     my $unapi = (split 'browse', $url)[0] . 'unapi';
1638
1639     my $path = $cgi->path_info;
1640     $path =~ s/^\///og;
1641
1642     my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1643     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses";
1644
1645     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1646
1647     my $status = [$cgi->param('status')];
1648     my $cpLoc = [$cgi->param('copyLocation')];
1649     $site ||= $cgi->param('searchOrg');
1650     $page ||= $cgi->param('startPage') || 0;
1651     $page_size ||= $cgi->param('count') || 9;
1652     $thesauruses //= '';
1653     $thesauruses =~ s/\s//g;
1654     # protect against cats bouncing on the comma key...
1655     $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1656
1657     $page = 0 if ($page !~ /^-?\d+$/);
1658     $page_size = 9 if $page_size !~ /^\d+$/;
1659
1660     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1661     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1662
1663     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1664         warn "something's wrong...";
1665         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1666         return undef;
1667     }
1668
1669     $string = decode_utf8($string);
1670     $string =~ s/\+/ /go;
1671     $string =~ s/'//go;
1672
1673     my $tree;
1674     if ($axis =~ /^authority/) {
1675         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1676
1677         my $method = "open-ils.supercat.authority.browse_center.by_axis";
1678         $method .= ".refs" if $refs;
1679
1680         $tree = $supercat->request(
1681             $method,
1682             $realaxis,
1683             $string,
1684             $page,
1685             $page_size,
1686             $thesauruses
1687         )->gather(1);
1688     } else {
1689         $tree = $supercat->request(
1690             "open-ils.supercat.$axis.browse",
1691             $string,
1692             $site,
1693             $page_size,
1694             $page,
1695             $status,
1696             $cpLoc
1697         )->gather(1);
1698     }
1699
1700     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1701
1702     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1703     print $header.$content;
1704     return Apache2::Const::OK;
1705 }
1706
1707 sub string_startwith {
1708     my $apache = shift;
1709     return Apache2::Const::DECLINED if (-e $apache->filename);
1710
1711     check_child_init();
1712
1713     my $cgi = new CGI;
1714     my $year = (gmtime())[5] + 1900;
1715
1716     my $host = $cgi->virtual_host || $cgi->server_name;
1717
1718     my $add_path = 0;
1719     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1720         my $rel_name = $cgi->url(-relative=>1);
1721         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1722     }
1723
1724     my $url = $cgi->url(-path_info=>$add_path);
1725     my $root = (split 'startwith', $url)[0];
1726     my $base = (split 'startwith', $url)[0] . 'startwith';
1727     my $unapi = (split 'startwith', $url)[0] . 'unapi';
1728
1729     my $path = $cgi->path_info;
1730     $path =~ s/^\///og;
1731
1732     my ($format,$axis,$site,$string,$page,$page_size,$thesauruses) = split '/', $path;
1733     #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size -> $thesauruses ";
1734
1735     my $status = [$cgi->param('status')];
1736     my $cpLoc = [$cgi->param('copyLocation')];
1737     $site ||= $cgi->param('searchOrg');
1738     $page ||= $cgi->param('startPage') || 0;
1739     $page_size ||= $cgi->param('count') || 9;
1740     $thesauruses //= '';
1741     $thesauruses =~ s/\s//g;
1742     # protect against cats bouncing on the comma key...
1743     $thesauruses = join(',', grep { $_ ne '' } split /,/, $thesauruses);
1744
1745     $page = 0 if ($page !~ /^-?\d+$/);
1746     $page_size = 9 if $page_size !~ /^\d+$/;
1747
1748     my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size,$thesauruses);
1749     my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size,$thesauruses);
1750
1751     unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1752         warn "something's wrong...";
1753         warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1754         return undef;
1755     }
1756
1757     $string = decode_utf8($string);
1758     $string =~ s/\+/ /go;
1759     $string =~ s/'//go;
1760
1761     my $tree;
1762     if ($axis =~ /^authority/) {
1763         my ($realaxis, $refs) = ($axis =~ $authority_axis_re);
1764
1765         my $method = "open-ils.supercat.authority.browse_top.by_axis";
1766         $method .= ".refs" if $refs;
1767
1768         $tree = $supercat->request(
1769             $method,
1770             $realaxis,
1771             $string,
1772             $page,
1773             $page_size,
1774             $thesauruses
1775         )->gather(1);
1776     } else {
1777         $tree = $supercat->request(
1778             "open-ils.supercat.$axis.startwith",
1779             $string,
1780             $site,
1781             $page_size,
1782             $page,
1783             $status,
1784             $cpLoc
1785         )->gather(1);
1786     }
1787
1788     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1789
1790     my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1791     print $header.$content;
1792     return Apache2::Const::OK;
1793 }
1794
1795 sub item_age_browse {
1796     my $apache = shift;
1797     return Apache2::Const::DECLINED if (-e $apache->filename);
1798
1799     check_child_init();
1800
1801     my $cgi = new CGI;
1802     my $year = (gmtime())[5] + 1900;
1803
1804     my $host = $cgi->virtual_host || $cgi->server_name;
1805
1806     my $add_path = 0;
1807     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1808         my $rel_name = $cgi->url(-relative=>1);
1809         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1810     }
1811
1812     my $url = $cgi->url(-path_info=>$add_path);
1813     my $root = (split 'browse', $url)[0];
1814     my $base = (split 'browse', $url)[0] . 'browse';
1815     my $unapi = (split 'browse', $url)[0] . 'unapi';
1816
1817     my $path = $cgi->path_info;
1818     $path =~ s/^\///og;
1819
1820     my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1821     #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1822
1823     unless ($axis eq 'item-age') {
1824         warn "something's wrong...";
1825         warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1826         return undef;
1827     }
1828
1829     my $status = [$cgi->param('status')];
1830     my $cpLoc = [$cgi->param('copyLocation')];
1831     $site ||= $cgi->param('searchOrg') || '-';
1832     $page ||= $cgi->param('startPage') || 1;
1833     $page_size ||= $cgi->param('count') || 10;
1834
1835     $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1836     $page_size = 10 if $page_size !~ /^\d+$/;
1837
1838     my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1839     my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1840
1841     my $recs = $supercat->request(
1842         "open-ils.supercat.new_book_list",
1843         $site,
1844         $page_size,
1845         $page,
1846         $status,
1847         $cpLoc
1848     )->gather(1);
1849
1850     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1851
1852     my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1853     print $header.$content;
1854     return Apache2::Const::OK;
1855 }
1856
1857 our %qualifier_ids = (
1858     eg  => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1859     dc  => 'info:srw/cql-context-set/1/dc-v1.1',
1860     bib => 'info:srw/cql-context-set/1/bib-v1.0',
1861     srw => ''
1862 );
1863
1864 # Our authority search options are currently pretty impoverished;
1865 # just right-truncated string match on a few categories, or by
1866 # ID number
1867 our %nested_auth_qualifier_map = (
1868         eg => {
1869             id          => { index => 'id', title => 'Record number'},
1870             name        => { index => 'author', title => 'Personal or corporate author, or meeting name'},
1871             title       => { index => 'title', title => 'Uniform title'},
1872             subject     => { index => 'subject', title => 'Chronological term, topical term, geographic name, or genre/form term'},
1873             topic       => { index => 'topic', title => 'Topical term'},
1874         },
1875 );
1876
1877 my $base_explain = <<XML;
1878 <explain
1879         id="evergreen-sru-explain-full"
1880         authoritative="true"
1881         xmlns:z="http://explain.z3950.org/dtd/2.0/"
1882         xmlns="http://explain.z3950.org/dtd/2.0/">
1883     <serverInfo transport="http" protocol="SRU" version="1.1">
1884         <host/>
1885         <port/>
1886         <database/>
1887     </serverInfo>
1888
1889     <databaseInfo>
1890         <title primary="true"/>
1891         <description primary="true"/>
1892     </databaseInfo>
1893
1894     <indexInfo>
1895         <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1896     </indexInfo>
1897
1898     <schemaInfo>
1899         <schema
1900                 identifier="info:srw/schema/1/marcxml-v1.1"
1901                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1902                 sort="true"
1903                 retrieve="true"
1904                 name="marcxml">
1905             <title>MARC21Slim (marcxml)</title>
1906         </schema>
1907     </schemaInfo>
1908
1909     <configInfo>
1910         <default type="numberOfRecords">10</default>
1911         <default type="contextSet">eg</default>
1912         <default type="index">keyword</default>
1913         <default type="relation">all</default>
1914         <default type="sortSchema">marcxml</default>
1915         <default type="retrieveSchema">marcxml</default>
1916         <setting type="maximumRecords">50</setting>
1917         <supports type="relationModifier">relevant</supports>
1918         <supports type="relationModifier">stem</supports>
1919         <supports type="relationModifier">fuzzy</supports>
1920         <supports type="relationModifier">word</supports>
1921     </configInfo>
1922
1923 </explain>
1924 XML
1925
1926
1927 my $ex_doc;
1928 sub sru_search {
1929     my $cgi = new CGI;
1930
1931     check_child_init();
1932
1933     my $req = SRU::Request->newFromCGI( $cgi );
1934     my $resp = SRU::Response->newFromRequest( $req );
1935
1936     # Find the org_unit shortname, if passed as part of the URL
1937     # http://example.com/opac/extras/sru/SHORTNAME
1938     my $url = $cgi->path_info;
1939     my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1940
1941     if ( $resp->type eq 'searchRetrieve' ) {
1942
1943         # Older versions of Debian packages returned terms to us double-encoded,
1944         # so we had to forcefully double-decode them a second time with
1945         # an outer decode('utf8', $string) call; this seems to be resolved with
1946         # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1947         my $cql_query = decode_utf8($req->query);
1948         my $search_string = decode_utf8($req->cql->toEvergreen);
1949
1950         # Ensure the search string overrides the default site
1951         if ($shortname and $search_string !~ m#site:#) {
1952             $search_string .= " site:$shortname";
1953         }
1954
1955         my $offset = $req->startRecord;
1956         $offset-- if ($offset);
1957         $offset ||= 0;
1958
1959         my $limit = $req->maximumRecords;
1960         $limit ||= 10;
1961
1962         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1963
1964          my $recs = $search->request(
1965             'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1966         )->gather(1);
1967
1968         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1969
1970         foreach my $record (@$bre) {
1971             my $marcxml = $record->marc;
1972             # Make the beast conform to a VDX-supported format
1973             # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1974             # Trying to implement LIBSOL_852_A format; so much for standards
1975             if ($holdings) {
1976                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1977                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1978
1979                 # Force record leader to 'a' as our data is always UTF8
1980                 # Avoids marc8_to_utf8 from being invoked with horrible results
1981                 # on the off-chance the record leader isn't correct
1982                 my $ldr = $marc->leader;
1983                 substr($ldr, 9, 1, 'a');
1984                 $marc->leader($ldr);
1985
1986                 # Expects the record ID in the 001
1987                 $marc->delete_field($_) for ($marc->field('001'));
1988                 if (!$marc->field('001')) {
1989                     $marc->insert_fields_ordered(
1990                         MARC::Field->new( '001', $record->id )
1991                     );
1992                 }
1993                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1994                 foreach my $cn (keys %$bib_holdings) {
1995                     foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1996                         $marc->insert_fields_ordered(
1997                             MARC::Field->new(
1998                                 '852', '4', '',
1999                                 a => $cp->{'location'},
2000                                 b => $bib_holdings->{$cn}->{'owning_lib'},
2001                                 c => $cn,
2002                                 d => $cp->{'circlib'},
2003                                 g => $cp->{'barcode'},
2004                                 n => $cp->{'status'},
2005                             )
2006                         );
2007                     }
2008                 }
2009
2010                 $marcxml = $marc->as_xml_record();
2011                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
2012
2013             }
2014             $resp->addRecord(
2015                 SRU::Response::Record->new(
2016                     recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2017                     recordData => $marcxml,
2018                     recordPosition => ++$offset
2019                 )
2020             );
2021         }
2022
2023         $resp->numberOfRecords($recs->{count});
2024
2025     } elsif ( $resp->type eq 'explain' ) {
2026         return_sru_explain($cgi, $req, $resp, \$ex_doc,
2027             undef,
2028             \%OpenILS::WWW::SuperCat::qualifier_ids
2029         );
2030
2031         $resp->record(
2032             SRU::Response::Record->new(
2033                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2034                 recordData        => $ex_doc
2035             )
2036         );
2037     }
2038
2039     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2040     print $U->entityize($resp->asXML) . "\n";
2041     return Apache2::Const::OK;
2042 }
2043
2044
2045 {
2046     package CQL::BooleanNode;
2047
2048     sub toEvergreen {
2049         my $self     = shift;
2050         my $left     = $self->left();
2051         my $right    = $self->right();
2052         my $leftStr  = $left->toEvergreen;
2053         my $rightStr = $right->toEvergreen();
2054
2055         my $op =  '||' if uc $self->op() eq 'OR';
2056         $op ||=  '&&';
2057
2058         return  "$leftStr $rightStr";
2059     }
2060
2061     sub toEvergreenAuth {
2062         return toEvergreen(shift);
2063     }
2064
2065     package CQL::TermNode;
2066
2067     sub toEvergreen {
2068         my $self      = shift;
2069         my $qualifier = $self->getQualifier();
2070         my $term      = $self->getTerm();
2071         my $relation  = $self->getRelation();
2072
2073         my $query;
2074         if ( $qualifier ) {
2075             my ($qset, $qname) = split(/\./, $qualifier);
2076
2077             # Per http://www.loc.gov/standards/sru/specs/cql.html
2078             # "All parts of CQL are case insensitive [...] If any case insensitive
2079             # part of CQL is specified with both upper and lower case, it is for
2080             # aesthetic purposes only."
2081
2082             # So fold the qualifier and relation to lower case
2083             $qset = lc($qset);
2084             $qname = lc($qname);
2085
2086             if ( exists($qualifier_map{$qset}{$qname}) ) {
2087                 $qualifier = $qualifier_map{$qset}{$qname}{'index'} || 'kw';
2088                 $log->debug("SRU toEvergreen: $qset, $qname   $qualifier_map{$qset}{$qname}{'index'}\n");
2089             }
2090
2091             my @modifiers = $relation->getModifiers();
2092
2093             my $base = $relation->getBase();
2094             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2095
2096                 my $quote_it = 1;
2097                 foreach my $m ( @modifiers ) {
2098                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2099                         $quote_it = 0;
2100                         last;
2101                     }
2102                 }
2103
2104                 $quote_it = 0 if ( $base eq 'all' );
2105                 $term = maybeQuote($term) if $quote_it;
2106
2107             } else {
2108                 croak( "Evergreen doesn't support the $base relations" );
2109             }
2110
2111
2112         } else {
2113             $qualifier = "kw";
2114         }
2115
2116         return "$qualifier:$term";
2117     }
2118
2119     sub toEvergreenAuth {
2120         my $self      = shift;
2121         my $qualifier = $self->getQualifier();
2122         my $term      = $self->getTerm();
2123         my $relation  = $self->getRelation();
2124
2125         my $query;
2126         if ( $qualifier ) {
2127             my ($qset, $qname) = split(/\./, $qualifier);
2128
2129             if ( exists($OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}) ) {
2130                 $qualifier = $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'} || 'author';
2131                 $log->debug("SRU toEvergreenAuth: $qset, $qname   $OpenILS::WWW::SuperCat::nested_auth_qualifier_map{$qset}{$qname}{'index'}\n");
2132             }
2133         }
2134         return { qualifier => $qualifier, term => $term };
2135     }
2136 }
2137
2138 my $auth_ex_doc;
2139 sub sru_auth_search {
2140     my $cgi = new CGI;
2141
2142     check_child_init();
2143
2144     my $req = SRU::Request->newFromCGI( $cgi );
2145     my $resp = SRU::Response->newFromRequest( $req );
2146
2147     if ( $resp->type eq 'searchRetrieve' ) {
2148         return_auth_response($cgi, $req, $resp);
2149     } elsif ( $resp->type eq 'explain' ) {
2150         return_sru_explain($cgi, $req, $resp, \$auth_ex_doc,
2151             \%OpenILS::WWW::SuperCat::nested_auth_qualifier_map,
2152             \%OpenILS::WWW::SuperCat::qualifier_ids
2153         );
2154     }
2155
2156     print $cgi->header( -type => 'application/xml', -charset => 'UTF-8' );
2157     print $U->entityize($resp->asXML) . "\n";
2158     return Apache2::Const::OK;
2159 }
2160
2161 sub explain_header {
2162     my $cgi = shift;
2163
2164     my $host = $cgi->virtual_host || $cgi->server_name;
2165
2166     my $add_path = 0;
2167     if ( $cgi->server_software !~ m|^Apache/2.2| ) {
2168         my $rel_name = $cgi->url(-relative=>1);
2169         $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
2170     }
2171     my $base = $cgi->url(-base=>1);
2172     my $url = $cgi->url(-path_info=>$add_path);
2173     $url =~ s/^$base\///o;
2174
2175     my $doc = $parser->parse_string($base_explain);
2176     my $e = $doc->documentElement;
2177     $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
2178     $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
2179     $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
2180
2181     return ($doc, $e);
2182 }
2183
2184 sub return_sru_explain {
2185     my ($cgi, $req, $resp, $explain, $index_map, $qualifier_ids) = @_;
2186
2187     $index_map ||= \%qualifier_map;
2188     if (!$$explain) {
2189         my ($doc, $e) = explain_header($cgi);
2190         for my $name ( keys %{$index_map} ) {
2191
2192             my $identifier = $qualifier_ids->{ $name };
2193
2194             next unless $identifier;
2195
2196             my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
2197             $set_node->setAttribute( identifier => $identifier );
2198             $set_node->setAttribute( name => $name );
2199
2200             $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
2201             for my $index ( sort keys %{$index_map->{$name}} ) {
2202                 my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
2203
2204                 my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
2205                 $map_node->appendChild( $name_node );
2206
2207                 my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
2208
2209                 my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
2210                 $index_node->appendChild( $title_node );
2211                 $index_node->appendChild( $map_node );
2212
2213                 $index_node->setAttribute( id => "$name.$index" );
2214                 $title_node->appendText($index_map->{$name}{$index}{'title'});
2215                 $name_node->setAttribute( set => $name );
2216                 $name_node->appendText($index_map->{$name}{$index}{'index'});
2217
2218                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
2219             }
2220         }
2221
2222         $$explain = $e->toString;
2223     }
2224
2225     $resp->record(
2226         SRU::Response::Record->new(
2227             recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
2228             recordData      => $$explain
2229         )
2230     );
2231
2232 }
2233
2234 sub return_auth_response {
2235     my ($cgi, $req, $resp) = @_;
2236
2237     my $cql_query = decode_utf8($req->query);
2238     my $search = $req->cql->toEvergreenAuth;
2239
2240     my $qualifier = decode_utf8($search->{qualifier});
2241     my $term = decode_utf8($search->{term});
2242
2243     $log->info("SRU NAF search string [$cql_query] converted to "
2244         . "[$qualifier:$term]\n");
2245
2246     my $page_size = $req->maximumRecords;
2247     $page_size ||= 10;
2248
2249     # startwith deals with pages, so convert startRecord to a page number
2250     my $page = ($req->startRecord / $page_size) || 0;
2251
2252     my $recs;
2253     if ($qualifier eq "id") {
2254         $recs = [ int($term) ];
2255     } else {
2256         my ($realaxis, $refs) = ($qualifier =~ $authority_axis_re);
2257
2258         my $method = "open-ils.supercat.authority.browse_top.by_axis";
2259         $method .= ".refs" if $refs;
2260
2261         $recs = $supercat->request(
2262             $method,
2263             $realaxis,
2264             $term,
2265             $page,
2266             $page_size
2267         )->gather(1);
2268     }
2269
2270     my $record_position = $req->startRecord;
2271     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
2272     foreach my $record (@$recs) {
2273         my $marcxml = $cstore->request(
2274             'open-ils.cstore.direct.authority.record_entry.retrieve', $record
2275         )->gather(1)->marc;
2276
2277         $resp->addRecord(
2278             SRU::Response::Record->new(
2279                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
2280                 recordData => $marcxml,
2281                 recordPosition => ++$record_position
2282             )
2283         );
2284     }
2285
2286     $resp->numberOfRecords(scalar(@$recs));
2287 }
2288
2289 =head2 get_ou($org_unit)
2290
2291 Returns an aou object for a given actor.org_unit shortname or ID.
2292
2293 =cut
2294
2295 sub get_ou {
2296     my $org = shift || '-';
2297     my $org_unit;
2298
2299     if ($org eq '-') {
2300          $org_unit = $actor->request(
2301             'open-ils.actor.org_unit_list.search' => parent_ou => undef
2302         )->gather(1);
2303     } elsif ($org !~ /^\d+$/o) {
2304          $org_unit = $actor->request(
2305             'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2306         )->gather(1);
2307     } else {
2308          $org_unit = $actor->request(
2309             'open-ils.actor.org_unit_list.search' => id => $org
2310         )->gather(1);
2311     }
2312
2313     return $org_unit;
2314 }
2315
2316 1;
2317
2318 # vim: et:ts=4:sw=4