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