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