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;
  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/&/&amp;/go;
  57                 $cn_label =~ s/'/&apos;/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 $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
 185         for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
 186             {
 187                 my $__f = 'marcxml';
 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         $limit = 10 if $limit !~ /^\d+$/;
 990
 991         my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
 992
 993         #if ($type eq 'opac') {
 994         #       print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 995         #               join('&', map { "rl=" . $_ } @$list) .
 996         #               "\n\n";
 997         #       return 302;
 998         #}
 999
1000         my $search = 'record';
1001         if ($rtype eq 'authority') {
1002                 $search = 'authority';
1003         }
1004         my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
1005         $feed->root($root);
1006
1007         if ($date) {
1008                 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
1009         } else {
1010                 $feed->title("$limit most recent $rtype ${axis}s");
1011         }
1012
1013         $feed->creator($host);
1014         $feed->update_ts();
1015
1016         $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
1017         $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
1018         $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
1019         $feed->link(unapi => $unapi);
1020
1021         $feed->link(
1022                 OPAC =>
1023                 "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
1024                         join('&', map { 'rl=' . $_} @$list ),
1025                 'text/html'
1026         );
1027
1028
1029         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
1030         print $U->entityize($feed->toString) . "\n";
1031
1032         return Apache2::Const::OK;
1033 }
1034
1035 sub opensearch_osd {
1036         my $version = shift;
1037         my $lib = shift;
1038         my $class = shift;
1039         my $base = shift;
1040
1041         if ($version eq '1.0') {
1042                 print <<OSD;
1043 Content-type: application/opensearchdescription+xml; charset=utf-8
1044
1045 <?xml version="1.0" encoding="UTF-8"?>
1046 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
1047   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&amp;startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
1048   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
1049   <ShortName>$lib</ShortName>
1050   <LongName>Search $lib</LongName>
1051   <Description>Search the $lib OPAC by $class.</Description>
1052   <Tags>$lib book library</Tags>
1053   <SampleSearch>harry+potter</SampleSearch>
1054   <Developer>Mike Rylander for GPLS/PINES</Developer>
1055   <Contact>feedback\@open-ils.org</Contact>
1056   <SyndicationRight>open</SyndicationRight>
1057   <AdultContent>false</AdultContent>
1058 </OpenSearchDescription>
1059 OSD
1060         } else {
1061                 print <<OSD;
1062 Content-type: application/opensearchdescription+xml; charset=utf-8
1063
1064 <?xml version="1.0" encoding="UTF-8"?>
1065 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
1066   <ShortName>$lib</ShortName>
1067   <Description>Search the $lib OPAC by $class.</Description>
1068   <Tags>$lib book library</Tags>
1069   <Url type="application/rss+xml"
1070        template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1071   <Url type="application/atom+xml"
1072        template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1073   <Url type="application/x-mods3+xml"
1074        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1075   <Url type="application/x-mods+xml"
1076        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1077   <Url type="application/x-marcxml+xml"
1078        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1079   <Url type="text/html"
1080        template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
1081   <LongName>Search $lib</LongName>
1082   <Query role="example" searchTerms="harry+potter" />
1083   <Developer>Mike Rylander for GPLS/PINES</Developer>
1084   <Contact>feedback\@open-ils.org</Contact>
1085   <SyndicationRight>open</SyndicationRight>
1086   <AdultContent>false</AdultContent>
1087   <Language>en-US</Language>
1088   <OutputEncoding>UTF-8</OutputEncoding>
1089   <InputEncoding>UTF-8</InputEncoding>
1090 </OpenSearchDescription>
1091 OSD
1092         }
1093
1094         return Apache2::Const::OK;
1095 }
1096
1097 sub opensearch_feed {
1098         my $apache = shift;
1099         return Apache2::Const::DECLINED if (-e $apache->filename);
1100
1101         my $cgi = new CGI;
1102         my $year = (gmtime())[5] + 1900;
1103
1104         my $host = $cgi->virtual_host || $cgi->server_name;
1105
1106         my $add_path = 0;
1107         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1108                 my $rel_name = $cgi->url(-relative=>1);
1109                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1110         }
1111
1112         my $url = $cgi->url(-path_info=>$add_path);
1113         my $root = (split 'opensearch', $url)[0];
1114         my $base = (split 'opensearch', $url)[0] . 'opensearch';
1115         my $unapi = (split 'opensearch', $url)[0] . 'unapi';
1116
1117         my $path = $cgi->path_info;
1118         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
1119
1120         if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
1121
1122                 my $version = $1;
1123                 my $lib = uc($2);
1124                 my $class = $3;
1125
1126                 if (!$lib || $lib eq '-') {
1127                         $lib = $actor->request(
1128                                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
1129                         )->gather(1)->[0]->shortname;
1130                 }
1131
1132                 if ($class eq '-') {
1133                         $class = 'keyword';
1134                 }
1135
1136                 return opensearch_osd($version, $lib, $class, $base);
1137         }
1138
1139
1140         my $page = $cgi->param('startPage') || 1;
1141         my $offset = $cgi->param('startIndex') || 1;
1142         my $limit = $cgi->param('count') || 10;
1143
1144         $page = 1 if ($page !~ /^\d+$/);
1145         $offset = 1 if ($offset !~ /^\d+$/);
1146         $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
1147
1148         if ($page > 1) {
1149                 $offset = ($page - 1) * $limit;
1150         } else {
1151                 $offset -= 1;
1152         }
1153
1154         my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
1155         (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
1156
1157         $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
1158         $lang = '' if ($lang eq '*');
1159
1160         $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1161         $sort ||= '';
1162         $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1163         $sortdir ||= '';
1164
1165         $terms .= " " if ($terms && $cgi->param('searchTerms'));
1166         $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1167
1168         $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1169         $class ||= '-';
1170
1171         $type = $cgi->param('responseType') if $cgi->param('responseType');
1172         $type ||= '-';
1173
1174         $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1175         $org ||= '-';
1176
1177
1178         my $kwt = $cgi->param('kw');
1179         my $tit = $cgi->param('ti');
1180         my $aut = $cgi->param('au');
1181         my $sut = $cgi->param('su');
1182         my $set = $cgi->param('se');
1183
1184         $terms .= " " if ($terms && $kwt);
1185         $terms .= "keyword: $kwt" if ($kwt);
1186         $terms .= " " if ($terms && $tit);
1187         $terms .= "title: $tit" if ($tit);
1188         $terms .= " " if ($terms && $aut);
1189         $terms .= "author: $aut" if ($aut);
1190         $terms .= " " if ($terms && $sut);
1191         $terms .= "subject: $sut" if ($sut);
1192         $terms .= " " if ($terms && $set);
1193         $terms .= "series: $set" if ($set);
1194
1195         if ($version eq '1.0') {
1196                 $type = 'rss2';
1197         } elsif ($type eq '-') {
1198                 $type = 'atom';
1199         }
1200         my $flesh_feed = parse_feed_type($type);
1201
1202         $terms = decode_utf8($terms);
1203         $lang = 'eng' if ($lang eq 'en-US');
1204
1205         $log->debug("OpenSearch terms: $terms");
1206
1207         my $org_unit = get_ou($org);
1208
1209         # Apostrophes break search and get indexed as spaces anyway
1210         my $safe_terms = $terms;
1211         $safe_terms =~ s{'}{ }go;
1212
1213         my $recs = $search->request(
1214                 'open-ils.search.biblio.multiclass.query' => {
1215                         org_unit        => $org_unit->[0]->id,
1216                         offset          => $offset,
1217                         limit           => $limit,
1218                         sort            => $sort,
1219                         sort_dir        => $sortdir,
1220             default_class => $class,
1221                         ($lang ?    ( 'language' => $lang    ) : ()),
1222                 } => $safe_terms => 1
1223         )->gather(1);
1224
1225         $log->debug("Hits for [$terms]: $recs->{count}");
1226
1227         my $feed = create_record_feed(
1228                 'record',
1229                 $type,
1230                 [ map { $_->[0] } @{$recs->{ids}} ],
1231                 $unapi,
1232                 $org,
1233                 undef,
1234                 $flesh_feed
1235         );
1236
1237         $log->debug("Feed created...");
1238
1239         $feed->root($root);
1240         $feed->lib($org);
1241         $feed->search($safe_terms);
1242         $feed->class($class);
1243
1244         $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1245
1246         $feed->creator($host);
1247         $feed->update_ts();
1248
1249         $feed->_create_node(
1250                 $feed->{item_xpath},
1251                 'http://a9.com/-/spec/opensearch/1.1/',
1252                 'totalResults',
1253                 $recs->{count},
1254         );
1255
1256         $feed->_create_node(
1257                 $feed->{item_xpath},
1258                 'http://a9.com/-/spec/opensearch/1.1/',
1259                 'startIndex',
1260                 $offset + 1,
1261         );
1262
1263         $feed->_create_node(
1264                 $feed->{item_xpath},
1265                 'http://a9.com/-/spec/opensearch/1.1/',
1266                 'itemsPerPage',
1267                 $limit,
1268         );
1269
1270         $log->debug("...basic feed data added...");
1271
1272         $feed->link(
1273                 next =>
1274                 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1275                 'application/opensearch+xml'
1276         ) if ($offset + $limit < $recs->{count});
1277
1278         $feed->link(
1279                 previous =>
1280                 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1281                 'application/opensearch+xml'
1282         ) if ($offset);
1283
1284         $feed->link(
1285                 self =>
1286                 $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1287                 'application/opensearch+xml'
1288         );
1289
1290         $feed->link(
1291                 alternate =>
1292                 $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1293                 'application/rss+xml'
1294         );
1295
1296         $feed->link(
1297                 atom =>
1298                 $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1299                 'application/atom+xml'
1300         );
1301
1302         $feed->link(
1303                 'html' =>
1304                 $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1305                 'text/html'
1306         );
1307
1308         $feed->link(
1309                 'html-full' =>
1310                 $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1311                 'text/html'
1312         );
1313
1314         $feed->link( 'unapi-server' => $unapi);
1315
1316         $log->debug("...feed links added...");
1317
1318 #       $feed->link(
1319 #               opac =>
1320 #               $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1321 #                       join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1322 #               'text/html'
1323 #       );
1324
1325         #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1326         print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1327
1328         $log->debug("...and feed returned.");
1329
1330         return Apache2::Const::OK;
1331 }
1332
1333 sub create_record_feed {
1334         my $search = shift;
1335         my $type = shift;
1336         my $records = shift;
1337         my $unapi = shift;
1338
1339         my $lib = uc(shift()) || '-';
1340         my $depth = shift;
1341         my $flesh = shift;
1342
1343         my $paging = shift;
1344
1345         my $cgi = new CGI;
1346         my $base = $cgi->url;
1347         my $host = $cgi->virtual_host || $cgi->server_name;
1348
1349     my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
1350     $year += 1900;
1351     $month += 1;
1352
1353     my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
1354
1355         my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
1356
1357         $type =~ s/(-full|-uris)$//o;
1358
1359         my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1360         $feed->base($base) if ($flesh);
1361         $feed->unapi($unapi) if ($flesh);
1362
1363         $type = 'atom' if ($type eq 'html');
1364         $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
1365
1366         #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1367
1368         my $count = 0;
1369         for my $record (@$records) {
1370                 next unless($record);
1371
1372                 #my $rec = $record->id;
1373                 my $rec = $record;
1374
1375                 my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
1376                 $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
1377                 $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
1378                 $item_tag .= "/$depth" if (defined($depth));
1379
1380                 $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
1381
1382                 my $xml = $supercat->request(
1383                         "open-ils.supercat.$search.$type.retrieve",
1384                         $rec
1385                 )->gather(1);
1386                 next unless $xml;
1387
1388                 my $node = $feed->add_item($xml);
1389                 next unless $node;
1390
1391                 $xml = '';
1392                 if ($lib && ($type eq 'marcxml' || $type eq 'atom') &&  $flesh > 0) {
1393                         my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
1394                         while ( !$r->complete ) {
1395                                 $xml .= join('', map {$_->content} $r->recv);
1396                         }
1397                         $xml .= join('', map {$_->content} $r->recv);
1398                         $node->add_holdings($xml);
1399                 }
1400
1401                 $node->id($item_tag);
1402                 #$node->update_ts(cleanse_ISO8601($record->edit_date));
1403                 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
1404                 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
1405                 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1406                 $node->link('unapi-id' => $item_tag) if ($flesh);
1407         }
1408
1409         return $feed;
1410 }
1411
1412 sub string_browse {
1413         my $apache = shift;
1414         return Apache2::Const::DECLINED if (-e $apache->filename);
1415
1416         my $cgi = new CGI;
1417         my $year = (gmtime())[5] + 1900;
1418
1419         my $host = $cgi->virtual_host || $cgi->server_name;
1420
1421         my $add_path = 0;
1422         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1423                 my $rel_name = $cgi->url(-relative=>1);
1424                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1425         }
1426
1427         my $url = $cgi->url(-path_info=>$add_path);
1428         my $root = (split 'browse', $url)[0];
1429         my $base = (split 'browse', $url)[0] . 'browse';
1430         my $unapi = (split 'browse', $url)[0] . 'unapi';
1431
1432         my $path = $cgi->path_info;
1433         $path =~ s/^\///og;
1434
1435         my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1436         #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1437
1438     return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
1439
1440         my $status = [$cgi->param('status')];
1441         my $cpLoc = [$cgi->param('copyLocation')];
1442         $site ||= $cgi->param('searchOrg');
1443         $page ||= $cgi->param('startPage') || 0;
1444         $page_size ||= $cgi->param('count') || 9;
1445
1446         $page = 0 if ($page !~ /^-?\d+$/);
1447         $page_size = 9 if $page_size !~ /^\d+$/;
1448
1449         my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1450         my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1451
1452         unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1453                 warn "something's wrong...";
1454                 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1455                 return undef;
1456         }
1457
1458         $string = decode_utf8($string);
1459         $string =~ s/\+/ /go;
1460         $string =~ s/'//go;
1461
1462         my $tree = $supercat->request(
1463                 "open-ils.supercat.$axis.browse",
1464                 $string,
1465                 (($axis =~ /^authority/) ? () : ($site)),
1466                 $page_size,
1467                 $page,
1468                 $status,
1469                 $cpLoc
1470         )->gather(1);
1471
1472     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1473
1474         my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1475         print $header.$content;
1476         return Apache2::Const::OK;
1477 }
1478
1479 sub string_startwith {
1480         my $apache = shift;
1481         return Apache2::Const::DECLINED if (-e $apache->filename);
1482
1483         my $cgi = new CGI;
1484         my $year = (gmtime())[5] + 1900;
1485
1486         my $host = $cgi->virtual_host || $cgi->server_name;
1487
1488         my $add_path = 0;
1489         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1490                 my $rel_name = $cgi->url(-relative=>1);
1491                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1492         }
1493
1494         my $url = $cgi->url(-path_info=>$add_path);
1495         my $root = (split 'startwith', $url)[0];
1496         my $base = (split 'startwith', $url)[0] . 'startwith';
1497         my $unapi = (split 'startwith', $url)[0] . 'unapi';
1498
1499         my $path = $cgi->path_info;
1500         $path =~ s/^\///og;
1501
1502         my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1503         #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1504
1505         my $status = [$cgi->param('status')];
1506         my $cpLoc = [$cgi->param('copyLocation')];
1507         $site ||= $cgi->param('searchOrg');
1508         $page ||= $cgi->param('startPage') || 0;
1509         $page_size ||= $cgi->param('count') || 9;
1510
1511         $page = 0 if ($page !~ /^-?\d+$/);
1512         $page_size = 9 if $page_size !~ /^\d+$/;
1513
1514         my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1515         my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1516
1517         unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1518                 warn "something's wrong...";
1519                 warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
1520                 return undef;
1521         }
1522
1523         $string = decode_utf8($string);
1524         $string =~ s/\+/ /go;
1525         $string =~ s/'//go;
1526
1527         my $tree = $supercat->request(
1528                 "open-ils.supercat.$axis.startwith",
1529                 $string,
1530                 (($axis =~ /^authority/) ? () : ($site)),
1531                 $page_size,
1532                 $page,
1533                 $status,
1534                 $cpLoc
1535         )->gather(1);
1536
1537     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1538
1539         my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1540         print $header.$content;
1541         return Apache2::Const::OK;
1542 }
1543
1544 sub item_age_browse {
1545         my $apache = shift;
1546         return Apache2::Const::DECLINED if (-e $apache->filename);
1547
1548         my $cgi = new CGI;
1549         my $year = (gmtime())[5] + 1900;
1550
1551         my $host = $cgi->virtual_host || $cgi->server_name;
1552
1553         my $add_path = 0;
1554         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1555                 my $rel_name = $cgi->url(-relative=>1);
1556                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1557         }
1558
1559         my $url = $cgi->url(-path_info=>$add_path);
1560         my $root = (split 'browse', $url)[0];
1561         my $base = (split 'browse', $url)[0] . 'browse';
1562         my $unapi = (split 'browse', $url)[0] . 'unapi';
1563
1564         my $path = $cgi->path_info;
1565         $path =~ s/^\///og;
1566
1567         my ($format,$axis,$site,$page,$page_size) = split '/', $path;
1568         #warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1569
1570         unless ($axis eq 'item-age') {
1571                 warn "something's wrong...";
1572                 warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
1573                 return undef;
1574         }
1575
1576         my $status = [$cgi->param('status')];
1577         my $cpLoc = [$cgi->param('copyLocation')];
1578         $site ||= $cgi->param('searchOrg') || '-';
1579         $page ||= $cgi->param('startPage') || 1;
1580         $page_size ||= $cgi->param('count') || 10;
1581
1582         $page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
1583         $page_size = 10 if $page_size !~ /^\d+$/;
1584
1585         my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
1586         my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
1587
1588         my $recs = $supercat->request(
1589                 "open-ils.supercat.new_book_list",
1590                 $site,
1591                 $page_size,
1592                 $page,
1593                 $status,
1594                 $cpLoc
1595         )->gather(1);
1596
1597     (my $norm_format = $format) =~ s/(-full|-uris)$//o;
1598
1599         my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
1600         print $header.$content;
1601         return Apache2::Const::OK;
1602 }
1603
1604 our %qualifier_map = (
1605
1606     # Some EG qualifiers
1607     'eg.site'               => 'site',
1608     'eg.sort'               => 'sort',
1609     'eg.direction'          => 'dir',
1610     'eg.available'          => 'available',
1611
1612     # Title class:
1613     'eg.title'              => 'title',
1614     'dc.title'              => 'title',
1615     'bib.titleabbreviated'  => 'title|abbreviated',
1616     'bib.titleuniform'      => 'title|uniform',
1617     'bib.titletranslated'   => 'title|translated',
1618     'bib.titlealternative'  => 'title',
1619     'bib.titleseries'       => 'series',
1620     'eg.series'             => 'title',
1621
1622     # Author/Name class:
1623     'eg.author'             => 'author',
1624     'eg.name'               => 'author',
1625     'creator'               => 'author',
1626     'dc.creator'            => 'author',
1627     'dc.contributer'        => 'author',
1628     'dc.publisher'          => 'keyword',
1629     'bib.name'              => 'author',
1630     'bib.namepersonal'      => 'author|personal',
1631     'bib.namepersonalfamily'=> 'author|personal',
1632     'bib.namepersonalgiven' => 'author|personal',
1633     'bib.namecorporate'     => 'author|corporate',
1634     'bib.nameconference'    => 'author|conference',
1635
1636     # Subject class:
1637     'eg.subject'            => 'subject',
1638     'dc.subject'            => 'subject',
1639     'bib.subjectplace'      => 'subject|geographic',
1640     'bib.subjecttitle'      => 'keyword',
1641     'bib.subjectname'       => 'subject|name',
1642     'bib.subjectoccupation' => 'keyword',
1643
1644     # Keyword class:
1645     'eg.keyword'            => 'keyword',
1646     'srw.serverchoice'      => 'keyword',
1647
1648     # Identifiers:
1649     'dc.identifier'         => 'keyword',
1650
1651     # Dates:
1652     'bib.dateissued'        => undef,
1653     'bib.datecreated'       => undef,
1654     'bib.datevalid'         => undef,
1655     'bib.datemodified'      => undef,
1656     'bib.datecopyright'     => undef,
1657
1658     # Resource Type:
1659     'dc.type'               => undef,
1660
1661     # Format:
1662     'dc.format'             => undef,
1663
1664     # Genre:
1665     'bib.genre'             => 'keyword',
1666
1667     # Target Audience:
1668     'bib.audience'          => undef,
1669
1670     # Place of Origin:
1671     'bib.originplace'       => undef,
1672
1673     # Language
1674     'dc.language'           => 'lang',
1675
1676     # Edition
1677     'bib.edition'           => 'keyword',
1678
1679     # Part:
1680     'bib.volume'            => 'keyword',
1681     'bib.issue'             => 'keyword',
1682     'bib.startpage'         => 'keyword',
1683     'bib.endpage'           => 'keyword',
1684
1685     # Issuance:
1686     'bib.issuance'          => 'keyword',
1687 );
1688
1689 our %qualifier_ids = (
1690                 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1691                 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1692                 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1693                 srw     => ''
1694 );
1695
1696 our %nested_qualifier_map = (
1697                 eg => {
1698                         site            => ['site','Evergreen Site Code (shortname)'],
1699                         sort            => ['sort','Sort on relevance, title, author, pubdate, create_date or edit_date'],
1700                         direction       => ['dir','Sort direction (asc|desc)'],
1701                         available       => ['available','Filter to available (true|false)'],
1702                         title           => ['title'],
1703                         author          => ['author'],
1704                         name            => ['author'],
1705                         subject         => ['subject'],
1706                         keyword         => ['keyword'],
1707                         series          => ['series'],
1708                 },
1709                 dc => {
1710                         title           => ['title'],
1711                         creator         => ['author'],
1712                         contributor     => ['author'],
1713                         publisher       => ['keyword'],
1714                         subject         => ['subject'],
1715                         identifier      => ['keyword'],
1716                         type            => [undef],
1717                         format          => [undef],
1718                         language        => ['lang'],
1719                 },
1720                 bib => {
1721                 # Title class:
1722                 titleAbbreviated        => ['title'],
1723                     titleUniform                => ['title'],
1724                         titleTranslated         => ['title'],
1725                 titleAlternative        => ['title'],
1726                     titleSeries                 => ['series'],
1727
1728     # Author/Name class:
1729                         name                            => ['author'],
1730                         namePersonal            => ['author'],
1731                         namePersonalFamily      => ['author'],
1732                         namePersonalGiven       => ['author'],
1733                         nameCorporate           => ['author'],
1734                         nameConference          => ['author'],
1735
1736                 # Subject class:
1737                         subjectPlace            => ['subject'],
1738                         subjectTitle            => ['keyword'],
1739                         subjectName                     => ['subject|name'],
1740                         subjectOccupation       => ['keyword'],
1741
1742     # Keyword class:
1743
1744     # Dates:
1745                         dateIssued                      => [undef],
1746                         dateCreated                     => [undef],
1747                         dateValid                       => [undef],
1748                         dateModified            => [undef],
1749                         dateCopyright           => [undef],
1750
1751     # Genre:
1752                         genre                           => ['keyword'],
1753
1754     # Target Audience:
1755                         audience                        => [undef],
1756
1757     # Place of Origin:
1758                         originPlace                     => [undef],
1759
1760     # Edition
1761                         edition                         => ['keyword'],
1762
1763     # Part:
1764                         volume                          => ['keyword'],
1765                         issue                           => ['keyword'],
1766                         startPage                       => ['keyword'],
1767                         endPage                         => ['keyword'],
1768
1769     # Issuance:
1770                         issuance                        => ['keyword'],
1771                 },
1772                 srw     => {
1773                         serverChoice            => ['keyword'],
1774                 },
1775 );
1776
1777
1778 my $base_explain = <<XML;
1779 <explain
1780                 id="evergreen-sru-explain-full"
1781                 authoritative="true"
1782                 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1783                 xmlns="http://explain.z3950.org/dtd/2.0/">
1784         <serverInfo transport="http" protocol="SRU" version="1.1">
1785                 <host/>
1786                 <port/>
1787                 <database/>
1788         </serverInfo>
1789
1790         <databaseInfo>
1791                 <title primary="true"/>
1792                 <description primary="true"/>
1793         </databaseInfo>
1794
1795         <indexInfo>
1796                 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1797         </indexInfo>
1798
1799         <schemaInfo>
1800                 <schema
1801                                 identifier="info:srw/schema/1/marcxml-v1.1"
1802                                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1803                                 sort="true"
1804                                 retrieve="true"
1805                                 name="marcxml">
1806                         <title>MARC21Slim (marcxml)</title>
1807                 </schema>
1808         </schemaInfo>
1809
1810         <configInfo>
1811                 <default type="numberOfRecords">50</default>
1812                 <default type="contextSet">eg</default>
1813                 <default type="index">keyword</default>
1814                 <default type="relation">all</default>
1815                 <default type="sortSchema">marcxml</default>
1816                 <default type="retrieveSchema">marcxml</default>
1817                 <setting type="maximumRecords">50</setting>
1818                 <supports type="relationModifier">relevant</supports>
1819                 <supports type="relationModifier">stem</supports>
1820                 <supports type="relationModifier">fuzzy</supports>
1821                 <supports type="relationModifier">word</supports>
1822         </configInfo>
1823
1824 </explain>
1825 XML
1826
1827
1828 my $ex_doc;
1829 sub sru_search {
1830         my $cgi = new CGI;
1831
1832         my $req = SRU::Request->newFromCGI( $cgi );
1833         my $resp = SRU::Response->newFromRequest( $req );
1834
1835         # Find the org_unit shortname, if passed as part of the URL
1836         # http://example.com/opac/extras/sru/SHORTNAME
1837         my $url = $cgi->path_info;
1838         my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
1839
1840         if ( $resp->type eq 'searchRetrieve' ) {
1841
1842                 # Older versions of Debian packages returned terms to us double-encoded,
1843                 # so we had to forcefully double-decode them a second time with
1844                 # an outer decode('utf8', $string) call; this seems to be resolved with
1845                 # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
1846                 my $cql_query = decode_utf8($req->query);
1847                 my $search_string = decode_utf8($req->cql->toEvergreen);
1848
1849                 # Ensure the search string overrides the default site
1850                 if ($shortname and $search_string !~ m#site:#) {
1851                         $search_string .= " site:$shortname";
1852                 }
1853
1854         my $offset = $req->startRecord;
1855         $offset-- if ($offset);
1856         $offset ||= 0;
1857
1858         my $limit = $req->maximumRecords;
1859         $limit ||= 10;
1860
1861         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1862
1863                 my $recs = $search->request(
1864                         'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1865                 )->gather(1);
1866
1867                 my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1868
1869                 foreach my $record (@$bre) {
1870                         my $marcxml = $record->marc;
1871                         # Make the beast conform to a VDX-supported format
1872                         # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
1873                         # Trying to implement LIBSOL_852_A format; so much for standards
1874                         if ($holdings) {
1875                                 my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
1876                                 my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
1877
1878                                 # Force record leader to 'a' as our data is always UTF8
1879                                 # Avoids marc8_to_utf8 from being invoked with horrible results
1880                                 # on the off-chance the record leader isn't correct
1881                                 my $ldr = $marc->leader;
1882                                 substr($ldr, 9, 1, 'a');
1883                                 $marc->leader($ldr);
1884
1885                                 # Expects the record ID in the 001
1886                                 $marc->delete_field($_) for ($marc->field('001'));
1887                                 if (!$marc->field('001')) {
1888                                         $marc->insert_fields_ordered(
1889                                                 MARC::Field->new( '001', $record->id )
1890                                         );
1891                                 }
1892                                 $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
1893                                 foreach my $cn (keys %$bib_holdings) {
1894                                         foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
1895                                                 $marc->insert_fields_ordered(
1896                                                         MARC::Field->new(
1897                                                                 '852', '4', '',
1898                                                                 a => $cp->{'location'},
1899                                                                 b => $bib_holdings->{$cn}->{'owning_lib'},
1900                                                                 c => $cn,
1901                                                                 d => $cp->{'circlib'},
1902                                                                 g => $cp->{'barcode'},
1903                                                                 n => $cp->{'status'},
1904                                                         )
1905                                                 );
1906                                         }
1907                                 }
1908
1909                                 # Ensure the data is encoded as UTF8 before we hand it off
1910                                 $marcxml = encode_utf8($marc->as_xml_record());
1911                                 $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
1912
1913                         }
1914                         $resp->addRecord(
1915                                 SRU::Response::Record->new(
1916                                         recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1917                                         recordData => $marcxml,
1918                                         recordPosition => ++$offset
1919                                 )
1920                         );
1921                 }
1922
1923                 $resp->numberOfRecords($recs->{count});
1924
1925         } elsif ( $resp->type eq 'explain' ) {
1926                 if (!$ex_doc) {
1927                         my $host = $cgi->virtual_host || $cgi->server_name;
1928
1929                         my $add_path = 0;
1930                         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1931                                 my $rel_name = $cgi->url(-relative=>1);
1932                                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1933                         }
1934                         my $base = $cgi->url(-base=>1);
1935                         my $url = $cgi->url(-path_info=>$add_path);
1936                         $url =~ s/^$base\///o;
1937
1938                         my $doc = $parser->parse_string($base_explain);
1939                         my $e = $doc->documentElement;
1940                         $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1941                         $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1942                         $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1943
1944                         for my $name ( keys %OpenILS::WWW::SuperCat::nested_qualifier_map ) {
1945
1946                                 my $identifier = $OpenILS::WWW::SuperCat::qualifier_ids{ $name };
1947
1948                                 next unless $identifier;
1949
1950                                 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
1951                                 $set_node->setAttribute( identifier => $identifier );
1952                                 $set_node->setAttribute( name => $name );
1953
1954                                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
1955
1956                                 for my $index ( keys %{ $OpenILS::WWW::SuperCat::nested_qualifier_map{$name} } ) {
1957                                         my $desc = $OpenILS::WWW::SuperCat::nested_qualifier_map{$name}{$index}[1] || $index;
1958
1959                                         my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
1960
1961                                         my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
1962                                         $map_node->appendChild( $name_node );
1963
1964                                         my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
1965
1966                                         my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
1967                                         $index_node->appendChild( $title_node );
1968                                         $index_node->appendChild( $map_node );
1969
1970                                         $index_node->setAttribute( id => $name . '.' . $index );
1971                                         $title_node->appendText( $desc );
1972                                         $name_node->setAttribute( set => $name );
1973                                         $name_node->appendText($index );
1974
1975                                         $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
1976                                 }
1977                         }
1978
1979                         $ex_doc = $e->toString;
1980                 }
1981
1982                 $resp->record(
1983                         SRU::Response::Record->new(
1984                                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1985                                 recordData              => $ex_doc
1986                         )
1987                 );
1988         }
1989
1990         print $cgi->header( -type => 'application/xml' );
1991         print $U->entityize($resp->asXML) . "\n";
1992         return Apache2::Const::OK;
1993 }
1994
1995
1996 {
1997     package CQL::BooleanNode;
1998
1999     sub toEvergreen {
2000         my $self     = shift;
2001         my $left     = $self->left();
2002         my $right    = $self->right();
2003         my $leftStr  = $left->toEvergreen;
2004         my $rightStr = $right->toEvergreen();
2005
2006         my $op =  '||' if uc $self->op() eq 'OR';
2007         $op ||=  '&&';
2008
2009         return  "$leftStr $rightStr";
2010     }
2011
2012     package CQL::TermNode;
2013
2014     sub toEvergreen {
2015         my $self      = shift;
2016         my $qualifier = $self->getQualifier();
2017         my $term      = $self->getTerm();
2018         my $relation  = $self->getRelation();
2019
2020         my $query;
2021         if ( $qualifier ) {
2022                         my ($qset, $qname) = split(/\./, $qualifier);
2023
2024                         $log->debug("SRU toEvergreen: $qset, $qname   $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0]\n");
2025
2026             if ( exists($OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}) ) {
2027                 $qualifier = $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0] || 'kw';
2028                         }
2029
2030             my @modifiers = $relation->getModifiers();
2031
2032             my $base = $relation->getBase();
2033             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
2034
2035                 my $quote_it = 1;
2036                 foreach my $m ( @modifiers ) {
2037                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
2038                         $quote_it = 0;
2039                         last;
2040                     }
2041                 }
2042
2043                 $quote_it = 0 if ( $base eq 'all' );
2044                 $term = maybeQuote($term) if $quote_it;
2045
2046             } else {
2047                 croak( "Evergreen doesn't support the $base relations" );
2048             }
2049
2050
2051         } else {
2052             $qualifier = "kw";
2053         }
2054
2055         return "$qualifier:$term";
2056     }
2057 }
2058
2059 =head2 get_ou($org_unit)
2060
2061 Returns an aou object for a given actor.org_unit shortname or ID.
2062
2063 =cut
2064
2065 sub get_ou {
2066         my $org = shift || '-';
2067         my $org_unit;
2068
2069         if ($org eq '-') {
2070                 $org_unit = $actor->request(
2071                         'open-ils.actor.org_unit_list.search' => parent_ou => undef
2072                 )->gather(1);
2073         } elsif ($org !~ /^\d+$/o) {
2074                 $org_unit = $actor->request(
2075                         'open-ils.actor.org_unit_list.search' => shortname => uc($org)
2076                 )->gather(1);
2077         } else {
2078                 $org_unit = $actor->request(
2079                         'open-ils.actor.org_unit_list.search' => id => $org
2080                 )->gather(1);
2081         }
2082
2083         return $org_unit;
2084 }
2085
2086 1;
2087
2088 # vim: noet:ts=4:sw=4