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