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