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