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