Open-ILS/src/perlmods/OpenILS/WWW/SuperCat.pm

   1 package OpenILS::WWW::SuperCat;
   2 use strict; use warnings;
   3
   4 use Apache2 ();
   5 use Apache2::Log;
   6 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
   7 use APR::Const    -compile => qw(:error SUCCESS);
   8 use Apache2::RequestRec ();
   9 use Apache2::RequestIO ();
  10 use Apache2::RequestUtil;
  11 use CGI;
  12 use Data::Dumper;
  13
  14 use OpenSRF::EX qw(:try);
  15 use OpenSRF::Utils qw/:datetime/;
  16 use OpenSRF::Utils::Cache;
  17 use OpenSRF::System;
  18 use OpenSRF::AppSession;
  19 use XML::LibXML;
  20
  21 use Encode;
  22 use Unicode::Normalize;
  23 use OpenILS::Utils::Fieldmapper;
  24 use OpenILS::WWW::SuperCat::Feed;
  25
  26
  27 # set the bootstrap config when this module is loaded
  28 my ($bootstrap, $supercat, $actor, $parser, $search);
  29
  30 sub import {
  31         my $self = shift;
  32         $bootstrap = shift;
  33 }
  34
  35
  36 sub child_init {
  37         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  38         $supercat = OpenSRF::AppSession->create('open-ils.supercat');
  39         $actor = OpenSRF::AppSession->create('open-ils.actor');
  40         $search = OpenSRF::AppSession->create('open-ils.search');
  41         $parser = new XML::LibXML;
  42 }
  43
  44 sub oisbn {
  45
  46         my $apache = shift;
  47         return Apache2::Const::DECLINED if (-e $apache->filename);
  48
  49         (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
  50
  51         my $list = $supercat
  52                 ->request("open-ils.supercat.oisbn", $isbn)
  53                 ->gather(1);
  54
  55         print "Content-type: application/xml; charset=utf-8\n\n";
  56         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
  57
  58         unless (exists $$list{metarecord}) {
  59                 print '<idlist/>';
  60                 return Apache2::Const::OK;
  61         }
  62
  63         print "<idlist metarecord='$$list{metarecord}'>\n";
  64
  65         for ( keys %{ $$list{record_list} } ) {
  66                 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
  67                 print "  <isbn record='$_'>$o</isbn>\n"
  68         }
  69
  70         print "</idlist>\n";
  71
  72         return Apache2::Const::OK;
  73 }
  74
  75 sub unapi {
  76
  77         my $apache = shift;
  78         return Apache2::Const::DECLINED if (-e $apache->filename);
  79
  80         my $cgi = new CGI;
  81         my $rel_name = quotemeta($cgi->url(-relative=>1));
  82
  83         my $add_path = 1;
  84         $add_path = 0 if ($cgi->url(-path_info=>1) =~ /$rel_name$/);
  85
  86
  87         my $url = $cgi->url(-path_info=>$add_path);
  88         my $root = (split 'unapi', $url)[0];
  89         my $base = (split 'unapi', $url)[0] . 'unapi';
  90
  91
  92         my $uri = $cgi->param('id') || '';
  93         my $host = $cgi->virtual_host || $cgi->server_name;
  94
  95         my $format = $cgi->param('format');
  96         my ($id,$type,$command) = ('','','');
  97
  98         if (!$format) {
  99                 print "Content-type: application/xml; charset=utf-8\n";
 100
 101                 if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
 102                         $id = $2;
 103                         $type = 'record';
 104                         $type = 'metarecord' if ($1 =~ /^m/o);
 105
 106                         my $list = $supercat
 107                         ->request("open-ils.supercat.$type.formats")
 108                                 ->gather(1);
 109
 110                         print "\n";
 111
 112                         my $body = "<formats id='$uri'><format name='opac' type='text/html'/>";
 113
 114                         for my $h (@$list) {
 115                                 my ($type) = keys %$h;
 116                                 $body .= "<format name='$type' type='application/xml'";
 117
 118                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 119                                         $body .= " $part='$$h{$type}{$part}'"
 120                                                 if ($$h{$type}{$part});
 121                                 }
 122
 123                                 $body .= '/>';
 124                         }
 125
 126                         $body .= "</formats>\n";
 127
 128                         $apache->custom_response( 300, $body);
 129                         return 300;
 130                 } else {
 131                         my $list = $supercat
 132                                 ->request("open-ils.supercat.record.formats")
 133                                 ->gather(1);
 134
 135                         push @$list,
 136                                 @{ $supercat
 137                                         ->request("open-ils.supercat.metarecord.formats")
 138                                         ->gather(1);
 139                                 };
 140
 141                         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 142                         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 143
 144                         print "<formats><format name='opac' type='text/html'/>";
 145
 146                         for my $h (@$list) {
 147                                 my ($type) = keys %$h;
 148                                 print "<format name='$type' type='application/xml'";
 149
 150                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 151                                         print " $part='$$h{$type}{$part}'"
 152                                                 if ($$h{$type}{$part});
 153                                 }
 154
 155                                 print '/>';
 156                         }
 157
 158                         print "</formats>\n";
 159
 160
 161                         return Apache2::Const::OK;
 162                 }
 163         }
 164
 165
 166         if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
 167                 $id = $2;
 168                 $type = 'record';
 169                 $type = 'metarecord' if ($1 =~ /^m/o);
 170                 $command = 'retrieve';
 171         }
 172
 173         if ($format eq 'opac') {
 174                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 175                         if ($type eq 'metarecord');
 176                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 177                         if ($type eq 'record');
 178                 return 302;
 179         } elsif ($format =~ /^html/o) {
 180                 my $feed = create_record_feed(
 181                         $format => [ $id ],
 182                         $base,
 183                 );
 184
 185                 $feed->root($root);
 186                 $feed->creator($host);
 187                 $feed->update_ts(gmtime_ISO8601());
 188
 189                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 190                 print entityize($feed->toString) . "\n";
 191
 192                 return Apache2::Const::OK;
 193         }
 194
 195         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 196         $req->wait_complete;
 197
 198         if ($req->failed) {
 199                 print "Content-type: text/html; charset=utf-8\n\n";
 200                 $apache->custom_response( 404, <<"              HTML");
 201                 <html>
 202                         <head>
 203                                 <title>$type $id not found!</title>
 204                         </head>
 205                         <body>
 206                                 <br/>
 207                                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 208                         </body>
 209                 </html>
 210                 HTML
 211                 return 404;
 212         }
 213
 214         print "Content-type: application/xml; charset=utf-8\n\n";
 215         print $req->gather(1);
 216
 217         return Apache2::Const::OK;
 218 }
 219
 220 sub supercat {
 221
 222         my $apache = shift;
 223         return Apache2::Const::DECLINED if (-e $apache->filename);
 224
 225         my $cgi = new CGI;
 226
 227         my $rel_name = quotemeta($cgi->url(-relative=>1));
 228
 229         my $add_path = 1;
 230         $add_path = 0 if ($cgi->url(-path_info=>1) =~ /$rel_name$/);
 231
 232
 233         my $url = $cgi->url(-path_info=>$add_path);
 234         my $root = (split 'supercat', $url)[0];
 235         my $base = (split 'supercat', $url)[0] . 'supercat';
 236         my $path = (split 'supercat', $url)[1];
 237         my $unapi = (split 'supercat', $url)[0] . 'unapi';
 238
 239         my $host = $cgi->virtual_host || $cgi->server_name;
 240
 241         my ($id,$type,$format,$command) = reverse split '/', $path;
 242
 243
 244         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 245                 print "Content-type: application/xml; charset=utf-8\n";
 246                 if ($1) {
 247                         my $list = $supercat
 248                                 ->request("open-ils.supercat.$1.formats")
 249                                 ->gather(1);
 250
 251                         print "\n";
 252
 253                         print "<formats>
 254                                    <format>
 255                                      <name>opac</name>
 256                                      <type>text/html</type>
 257                                    </format>";
 258
 259                         for my $h (@$list) {
 260                                 my ($type) = keys %$h;
 261                                 print "<format><name>$type</name><type>application/xml</type>";
 262
 263                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 264                                         print "<$part>$$h{$type}{$part}</$part>"
 265                                                 if ($$h{$type}{$part});
 266                                 }
 267
 268                                 print '</format>';
 269                         }
 270
 271                         print "</formats>\n";
 272
 273                         return Apache2::Const::OK;
 274                 }
 275
 276                 my $list = $supercat
 277                         ->request("open-ils.supercat.record.formats")
 278                         ->gather(1);
 279
 280                 push @$list,
 281                         @{ $supercat
 282                                 ->request("open-ils.supercat.metarecord.formats")
 283                                 ->gather(1);
 284                         };
 285
 286                 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 287                 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 288
 289                 print "\n<formats>
 290                            <format>
 291                              <name>opac</name>
 292                              <type>text/html</type>
 293                            </format>";
 294
 295                 for my $h (@$list) {
 296                         my ($type) = keys %$h;
 297                         print "<format><name>$type</name><type>application/xml</type>";
 298
 299                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 300                                 print "<$part>$$h{$type}{$part}</$part>"
 301                                         if ($$h{$type}{$part});
 302                         }
 303
 304                         print '</format>';
 305                 }
 306
 307                 print "</formats>\n";
 308
 309
 310                 return Apache2::Const::OK;
 311         }
 312
 313         if ($format eq 'opac') {
 314                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 315                         if ($type eq 'metarecord');
 316                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 317                         if ($type eq 'record');
 318                 return 302;
 319         } elsif ($format =~ /^html/o) {
 320                 my $feed = create_record_feed( $format => [ $id ], $unapi,);
 321
 322                 $feed->root($root);
 323                 $feed->creator($host);
 324                 $feed->update_ts(gmtime_ISO8601());
 325
 326                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 327                 print entityize($feed->toString) . "\n";
 328
 329                 return Apache2::Const::OK;
 330         }
 331
 332         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 333         $req->wait_complete;
 334
 335         if ($req->failed) {
 336                 print "Content-type: text/html; charset=utf-8\n\n";
 337                 $apache->custom_response( 404, <<"              HTML");
 338                 <html>
 339                         <head>
 340                                 <title>$type $id not found!</title>
 341                         </head>
 342                         <body>
 343                                 <br/>
 344                                 <center>Sorry, we couldn't $command a $type with the id of $id.</center>
 345                         </body>
 346                 </html>
 347                 HTML
 348                 return 404;
 349         }
 350
 351         print "Content-type: application/xml; charset=utf-8\n\n";
 352         print entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
 353
 354         return Apache2::Const::OK;
 355 }
 356
 357
 358 sub bookbag_feed {
 359         my $apache = shift;
 360         return Apache2::Const::DECLINED if (-e $apache->filename);
 361
 362         my $cgi = new CGI;
 363
 364         my $year = (gmtime())[5] + 1900;
 365         my $host = $cgi->virtual_host || $cgi->server_name;
 366
 367         my $rel_name = quotemeta($cgi->url(-relative=>1));
 368
 369         my $add_path = 1;
 370         $add_path = 0 if ($cgi->url(-path_info=>1) =~ /$rel_name$/);
 371
 372         my $url = $cgi->url(-path_info=>$add_path);
 373         my $root = (split 'feed', $url)[0];
 374         my $base = (split 'bookbag', $url)[0] . 'bookbag';
 375         my $path = (split 'bookbag', $url)[1];
 376         my $unapi = (split 'feed', $url)[0] . 'unapi';
 377
 378
 379         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 380
 381         my ($id,$type) = reverse split '/', $path;
 382
 383         my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
 384         return Apache2::Const::NOT_FOUND unless($bucket);
 385
 386         my $bucket_tag = "tag:$host,$year:record_bucket/$id";
 387         if ($type eq 'opac') {
 388                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 389                         join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
 390                         "\n\n";
 391                 return 302;
 392         }
 393
 394         my $feed = create_record_feed(
 395                 $type,
 396                 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
 397                 $unapi,
 398         );
 399         $feed->root($root);
 400
 401         $feed->title("Items in Book Bag [".$bucket->name."]");
 402         $feed->creator($host);
 403         $feed->update_ts(gmtime_ISO8601());
 404
 405         $feed->link(atom => $base . "/atom/$id" => 'application/atom+xml');
 406         $feed->link(rss2 => $base . "/rss2/$id");
 407         $feed->link(html => $base . "/html/$id" => 'text/html');
 408         $feed->link(unapi => $unapi);
 409
 410         $feed->link(
 411                 OPAC =>
 412                 '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 413                         join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
 414                 'text/html'
 415         );
 416
 417
 418         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 419         print entityize($feed->toString) . "\n";
 420
 421         return Apache2::Const::OK;
 422 }
 423
 424 sub changes_feed {
 425         my $apache = shift;
 426         return Apache2::Const::DECLINED if (-e $apache->filename);
 427
 428         my $cgi = new CGI;
 429
 430         my $year = (gmtime())[5] + 1900;
 431         my $host = $cgi->virtual_host || $cgi->server_name;
 432
 433         my $rel_name = quotemeta($cgi->url(-relative=>1));
 434
 435         my $add_path = 1;
 436         $add_path = 0 if ($cgi->url(-path_info=>1) =~ /$rel_name$/);
 437
 438         my $url = $cgi->url(-path_info=>$add_path);
 439         my $root = (split 'feed', $url)[0];
 440         my $base = (split 'freshmeat', $url)[0] . 'freshmeat';
 441         my $path = (split 'freshmeat', $url)[1];
 442         my $unapi = (split 'feed', $url)[0] . 'unapi';
 443
 444
 445         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 446
 447         $path =~ s/^\///og;
 448
 449         my ($type,$rtype,$axis,$date,$limit) = split '/', $path;
 450         $date ||= 'today';
 451         $limit ||= 10;
 452
 453         my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
 454
 455         if ($type eq 'opac') {
 456                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 457                         join('&', map { "rl=" . $_ } @$list) .
 458                         "\n\n";
 459                 return 302;
 460         }
 461
 462         my $feed = create_record_feed( $type, $list, $unapi);
 463         $feed->root($root);
 464
 465         $feed->title("$limit most recent $rtype changes from $date forward");
 466         $feed->creator($host);
 467         $feed->update_ts(gmtime_ISO8601());
 468
 469         $feed->link(atom => $base . "/atom/$rtype/$axis/$date/$limit" => 'application/atom+xml');
 470         $feed->link(rss2 => $base . "/rss2/$rtype/$axis/$date/$limit");
 471         $feed->link(html => $base . "/html/$rtype/$axis/$date/$limit" => 'text/html');
 472         $feed->link(unapi => $unapi);
 473
 474         $feed->link(
 475                 OPAC =>
 476                 '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 477                         join('&', map { 'rl=' . $_} @$list ),
 478                 'text/html'
 479         );
 480
 481
 482         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 483         print entityize($feed->toString) . "\n";
 484
 485         return Apache2::Const::OK;
 486 }
 487
 488 sub opensearch_osd {
 489         my $version = shift;
 490         my $lib = shift;
 491         my $class = shift;
 492         my $base = shift;
 493
 494         if ($version eq '1.0') {
 495                 print <<OSD;
 496 Content-type: application/opensearchdescription+xml; charset=utf-8
 497
 498 <?xml version="1.0" encoding="UTF-8"?>
 499 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
 500   <Url>$base/1.0/$lib/-/$class/{searchTerms}?startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
 501   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
 502   <ShortName>$lib</ShortName>
 503   <LongName>Search $lib</LongName>
 504   <Description>Search the $lib OPAC by $class.</Description>
 505   <Tags>$lib book library</Tags>
 506   <SampleSearch>harry+potter</SampleSearch>
 507   <Developer>Mike Rylander for GPLS/PINES</Developer>
 508   <Contact>feedback\@open-ils.org</Contact>
 509   <SyndicationRight>open</SyndicationRight>
 510   <AdultContent>false</AdultContent>
 511 </OpenSearchDescription>
 512 OSD
 513         } else {
 514                 print <<OSD;
 515 Content-type: application/opensearchdescription+xml; charset=utf-8
 516
 517 <?xml version="1.0" encoding="UTF-8"?>
 518 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
 519   <ShortName>$lib</ShortName>
 520   <Description>Search the $lib OPAC by $class.</Description>
 521   <Tags>$lib book library</Tags>
 522   <Url type="application/atom+xml"
 523        template="$base/1.1/$lib/atom/$class/{searchTerms}?startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;language={language?}"/>
 524   <Url type="application/x-rss+xml"
 525        template="$base/1.1/$lib/rss2/$class/{searchTerms}?startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;language={language?}"/>
 526   <Url type="application/x-mods3+xml"
 527        template="$base/1.1/$lib/mods3/$class/{searchTerms}?startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;language={language?}"/>
 528   <Url type="application/x-mods+xml"
 529        template="$base/1.1/$lib/mods/$class/{searchTerms}?startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;language={language?}"/>
 530   <Url type="application/x-marcxml+xml"
 531        template="$base/1.1/$lib/marcxml/$class/{searchTerms}?startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;language={language?}"/>
 532   <LongName>Search $lib</LongName>
 533   <Query role="example" searchTerms="harry+potter" />
 534   <Developer>Mike Rylander for GPLS/PINES</Developer>
 535   <SyndicationRight>open</SyndicationRight>
 536   <AdultContent>false</AdultContent>
 537   <Language>en-US</Language>
 538   <OutputEncoding>UTF-8</OutputEncoding>
 539   <InputEncoding>UTF-8</InputEncoding>
 540 </OpenSearchDescription>
 541 OSD
 542         }
 543
 544         return Apache2::Const::OK;
 545 }
 546
 547 sub opensearch_feed {
 548         my $apache = shift;
 549         return Apache2::Const::DECLINED if (-e $apache->filename);
 550
 551         my $cgi = new CGI;
 552         my $year = (gmtime())[5] + 1900;
 553
 554         my $host = $cgi->virtual_host || $cgi->server_name;
 555
 556         my $rel_name = quotemeta($cgi->url(-relative=>1));
 557
 558         my $add_path = 1;
 559         $add_path = 0 if ($cgi->url(-path_info=>1) =~ /$rel_name$/);
 560
 561         my $url = $cgi->url(-path_info=>$add_path);
 562         my $root = (split 'opensearch', $url)[0];
 563         my $base = (split 'opensearch', $url)[0] . 'opensearch';
 564         my $unapi = (split 'opensearch', $url)[0] . 'unapi';
 565
 566
 567         my $path = (split 'opensearch', $url)[1];
 568
 569         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 570
 571         if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
 572
 573                 my $version = $1;
 574                 my $lib = $2;
 575                 my $class = $3;
 576
 577                 if (!$lib) {
 578                         $lib = $actor->request(
 579                                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
 580                         )->gather(1)->[0]->shortname;
 581                 }
 582
 583                 if ($class eq '-') {
 584                         $class = 'keyword';
 585                 }
 586
 587                 return opensearch_osd($version, $lib, $class, $base);
 588         }
 589
 590
 591         my $page = $cgi->param('startPage') || 1;
 592         my $offset = $cgi->param('startIndex') || 1;
 593         my $limit = $cgi->param('count') || 10;
 594         my $lang = $cgi->param('language') || 'en-US';
 595
 596         $page = 1 if ($page !~ /^\d+$/);
 597         $offset = 1 if ($offset !~ /^\d+$/);
 598         $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
 599         $lang = 'en-US' if ($lang =~ /^{/ or $lang eq '*');
 600
 601         if ($page > 1) {
 602                 $offset = ($page - 1) * $limit;
 603         } else {
 604                 $offset -= 1;
 605         }
 606
 607         my (undef,$version,$org,$type,$class,$terms) = split '/', $path;
 608
 609         $terms ||= $cgi->param('searchTerms');
 610         $class ||= $cgi->param('searchClass') || '-';
 611         $type ||= $cgi->param('responseType') || '-';
 612         $org ||= $cgi->param('searchOrg') || '-';
 613
 614         if ($version eq '1.0') {
 615                 $type = 'rss2';
 616         } elsif ($type eq '-') {
 617                 $type = 'atom';
 618         }
 619
 620
 621         $class = 'keyword' if ($class eq '-');
 622         $terms = decode_utf8($terms);
 623         $terms =~ s/\+/ /go;
 624         $terms =~ s/'//go;
 625
 626         #warn "searching for $class -> [$terms] via OS $version, response type $type";
 627
 628         my $org_unit;
 629         if ($org eq '-') {
 630                 $org_unit = $actor->request(
 631                         'open-ils.actor.org_unit_list.search' => parent_ou => undef
 632                 )->gather(1);
 633         } else {
 634                 $org_unit = $actor->request(
 635                         'open-ils.actor.org_unit_list.search' => shortname => $org
 636                 )->gather(1);
 637         }
 638
 639         my $rs_name = $cgi->cookie('os_session');
 640         my $cached_res = OpenSRF::Utils::Cache->new->get_cache( "os_session:$rs_name" ) if ($rs_name);
 641
 642         my $recs;
 643         if (!($recs = $$cached_res{os_results}{$class}{$terms}{$org})) {
 644                 warn "NOT pulling results from cache";
 645                 $rs_name = $cgi->remote_host . '::' . rand(time);
 646                 $recs = $search->request(
 647                         'open-ils.search.biblio.multiclass' => {
 648                                 searches        => { $class => { term => $terms, }, },
 649                                 org_unit        => $org_unit->[0]->id,
 650                                 offset          => 0,
 651                                 limit           => 5000,
 652                         }
 653                 )->gather(1);
 654                 try {
 655                         $$cached_res{os_results}{$class}{$terms}{$org} = $recs;
 656                         OpenSRF::Utils::Cache->new->put_cache( "os_session:$rs_name", $cached_res, 1800 );
 657                 } catch Error with {
 658                         warn shift();
 659                 };
 660         }
 661
 662         my $feed = create_record_feed(
 663                 $type,
 664                 [ map { $_->[0] } @{$recs->{ids}}[$offset .. $offset + $limit - 1] ],
 665                 $unapi,
 666         );
 667         $feed->root($root);
 668         $feed->lib($org);
 669         $feed->search($terms);
 670
 671         $feed->title("Search results for [$class => $terms] at ".$org_unit->[0]->name);
 672         $feed->creator($host);
 673         $feed->update_ts(gmtime_ISO8601());
 674
 675         $feed->_create_node(
 676                 $feed->{item_xpath},
 677                 'http://a9.com/-/spec/opensearch/1.1/',
 678                 'totalResults',
 679                 $recs->{count},
 680         );
 681
 682         $feed->_create_node(
 683                 $feed->{item_xpath},
 684                 'http://a9.com/-/spec/opensearch/1.1/',
 685                 'startIndex',
 686                 $offset + 1,
 687         );
 688
 689         $feed->_create_node(
 690                 $feed->{item_xpath},
 691                 'http://a9.com/-/spec/opensearch/1.1/',
 692                 'itemsPerPage',
 693                 $limit,
 694         );
 695
 696         $feed->link(
 697                 next =>
 698                 $base . "/$version/$org/$type/$class?searchTerms=$terms&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
 699                 'application/opensearch+xml'
 700         ) if ($offset + $limit < $recs->{count});
 701
 702         $feed->link(
 703                 previous =>
 704                 $base . "/$version/$org/$type/$class?searchTerms=$terms&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
 705                 'application/opensearch+xml'
 706         ) if ($offset);
 707
 708         $feed->link(
 709                 self =>
 710                 $base .  "/$version/$org/$type/$class?searchTerms=$terms" =>
 711                 'application/opensearch+xml'
 712         );
 713
 714         $feed->link( unapi => $unapi);
 715
 716 #       $feed->link(
 717 #               alternate =>
 718 #               $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
 719 #                       join('&', map { 'rl=' . $_->[0] } @{$recs->{ids}} ),
 720 #               'text/html'
 721 #       );
 722
 723         $feed->link(
 724                 opac =>
 725                 $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
 726                         join('&', map { 'rl=' . $_->[0] } grep { defined $_ } @{$recs->{ids}} ),
 727                 'text/html'
 728         );
 729
 730         print $cgi->header(
 731                 -type           => $feed->type,
 732                 -charset        => 'UTF-8',
 733                 -cookie         => $cgi->cookie( -name => 'os_session', -value => $rs_name, -expires => '+30m' ),
 734         );
 735
 736         print entityize($feed->toString) . "\n";
 737
 738         return Apache2::Const::OK;
 739 }
 740
 741 sub create_record_feed {
 742         my $type = shift;
 743         my $records = shift;
 744         my $unapi = shift;
 745
 746         my $cgi = new CGI;
 747         my $base = $cgi->url;
 748         my $host = $cgi->virtual_host || $cgi->server_name;
 749
 750         my $year = (gmtime())[5] + 1900;
 751
 752         my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
 753         $feed->base($base);
 754         $feed->unapi($unapi);
 755
 756         $type = 'atom' if ($type eq 'html');
 757         $type = 'marcxml' if ($type eq 'htmlcard');
 758
 759         for my $rec (@$records) {
 760                 next unless($rec);
 761
 762                 my $item_tag = "tag:$host,$year:biblio-record_entry/" . $rec;
 763
 764
 765                 my $xml = $supercat->request(
 766                         "open-ils.supercat.record.$type.retrieve",
 767                         $rec
 768                 )->gather(1);
 769
 770                 my $node = $feed->add_item($xml);
 771
 772                 $node->id($item_tag);
 773                 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=opac" => 'text/html');
 774                 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac");
 775                 $node->link(unapi => $feed->unapi . "?id=$item_tag");
 776                 $node->link('unapi-id' => $item_tag);
 777         }
 778
 779         return $feed;
 780 }
 781
 782 sub entityize {
 783         my $stuff = NFC(shift());
 784         $stuff =~ s/&(?!\S+;)/&amp;/gso;
 785         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 786         return $stuff;
 787 }
 788
 789 1;