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