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