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