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