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 use OpenSRF::Utils::Logger qw/$logger/;
  26
  27
  28 # set the bootstrap config when this module is loaded
  29 my ($bootstrap, $cstore, $supercat, $actor, $parser, $search);
  30
  31 sub import {
  32         my $self = shift;
  33         $bootstrap = shift;
  34 }
  35
  36
  37 sub child_init {
  38         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  39
  40         my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
  41         Fieldmapper->import(IDL => $idl);
  42
  43         $supercat = OpenSRF::AppSession->create('open-ils.supercat');
  44         $cstore = OpenSRF::AppSession->create('open-ils.cstore');
  45         $actor = OpenSRF::AppSession->create('open-ils.actor');
  46         $search = OpenSRF::AppSession->create('open-ils.search');
  47         $parser = new XML::LibXML;
  48 }
  49
  50 sub oisbn {
  51
  52         my $apache = shift;
  53         return Apache2::Const::DECLINED if (-e $apache->filename);
  54
  55         (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
  56
  57         my $list = $supercat
  58                 ->request("open-ils.supercat.oisbn", $isbn)
  59                 ->gather(1);
  60
  61         print "Content-type: application/xml; charset=utf-8\n\n";
  62         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
  63
  64         unless (exists $$list{metarecord}) {
  65                 print '<idlist/>';
  66                 return Apache2::Const::OK;
  67         }
  68
  69         print "<idlist metarecord='$$list{metarecord}'>\n";
  70
  71         for ( keys %{ $$list{record_list} } ) {
  72                 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
  73                 print "  <isbn record='$_'>$o</isbn>\n"
  74         }
  75
  76         print "</idlist>\n";
  77
  78         return Apache2::Const::OK;
  79 }
  80
  81 sub unapi {
  82
  83         my $apache = shift;
  84         return Apache2::Const::DECLINED if (-e $apache->filename);
  85
  86         my $cgi = new CGI;
  87
  88         my $add_path = 0;
  89         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
  90                 my $rel_name = $cgi->url(-relative=>1);
  91                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
  92         }
  93
  94         my $url = $cgi->url(-path_info=>$add_path);
  95         my $root = (split 'unapi', $url)[0];
  96         my $base = (split 'unapi', $url)[0] . 'unapi';
  97
  98
  99         my $uri = $cgi->param('id') || '';
 100         my $host = $cgi->virtual_host || $cgi->server_name;
 101
 102         my $format = $cgi->param('format');
 103         my $flesh_feed = ($format =~ /-full$/o) ? 1 : 0;
 104         (my $base_format = $format) =~ s/-full$//o;
 105         my ($id,$type,$command,$lib) = ('','','');
 106
 107         if (!$format) {
 108                 my $body = "Content-type: application/xml; charset=utf-8\n\n";
 109
 110                 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^/]+)(?:/(.+))$}o) {
 111                         $id = $2;
 112                         $lib = $3;
 113                         $type = 'record';
 114                         $type = 'metarecord' if ($1 =~ /^m/o);
 115
 116                         my $list = $supercat
 117                                 ->request("open-ils.supercat.$type.formats")
 118                                 ->gather(1);
 119
 120                         if ($type eq 'record' or $type eq 'isbn') {
 121                                 $body .= <<"                            FORMATS";
 122 <formats id='$uri'>
 123         <format name='opac' type='text/html'/>
 124         <format name='html' type='text/html'/>
 125         <format name='htmlholdings' type='text/html'/>
 126         <format name='html-full' type='text/html'/>
 127         <format name='htmlholdings-full' type='text/html'/>
 128                                 FORMATS
 129                         } elsif ($type eq 'metarecord') {
 130                                 $body .= <<"                            FORMATS";
 131                                 <formats id='$uri'>
 132                                         <format name='opac' type='text/html'/>
 133                                 FORMATS
 134                         }
 135
 136                         for my $h (@$list) {
 137                                 my ($type) = keys %$h;
 138                                 $body .= "\t<format name='$type' type='application/xml'";
 139
 140                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 141                                         $body .= " $part='$$h{$type}{$part}'"
 142                                                 if ($$h{$type}{$part});
 143                                 }
 144
 145                                 $body .= "/>\n";
 146
 147                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 148                                         $body .= "\t<format name='$type-full' type='application/xml'";
 149
 150                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 151                                                 $body .= " $part='$$h{$type}{$part}'"
 152                                                         if ($$h{$type}{$part});
 153                                         }
 154
 155                                         $body .= "/>\n";
 156                                 }
 157                         }
 158
 159                         $body .= "</formats>\n";
 160
 161                 } else {
 162                         my $list = $supercat
 163                                 ->request("open-ils.supercat.record.formats")
 164                                 ->gather(1);
 165
 166                         push @$list,
 167                                 @{ $supercat
 168                                         ->request("open-ils.supercat.metarecord.formats")
 169                                         ->gather(1);
 170                                 };
 171
 172                         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 173                         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 174
 175                         $body .= <<"                    FORMATS";
 176 <formats>
 177         <format name='opac' type='text/html'/>
 178         <format name='html' type='text/html'/>
 179         <format name='htmlholdings' type='text/html'/>
 180         <format name='html-full' type='text/html'/>
 181         <format name='htmlholdings-full' type='text/html'/>
 182                         FORMATS
 183
 184
 185                         for my $h (@$list) {
 186                                 my ($type) = keys %$h;
 187                                 $body .= "\t<format name='$type' type='application/xml'";
 188
 189                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 190                                         $body .= " $part='$$h{$type}{$part}'"
 191                                                 if ($$h{$type}{$part});
 192                                 }
 193
 194                                 $body .= "/>\n";
 195
 196                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 197                                         $body .= "\t<format name='$type-full' type='application/xml'";
 198
 199                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 200                                                 $body .= " $part='$$h{$type}{$part}'"
 201                                                         if ($$h{$type}{$part});
 202                                         }
 203
 204                                         $body .= "/>\n";
 205                                 }
 206                         }
 207
 208                         $body .= "</formats>\n";
 209
 210                 }
 211                 print $body;
 212                 return Apache2::Const::OK;
 213         }
 214
 215         if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^/]+)(?:/(.+))?}o) {
 216                 $id = $2;
 217                 $lib = $3;
 218                 $type = 'record';
 219                 $type = 'metarecord' if ($1 =~ /^metabib/o);
 220                 $type = 'isbn' if ($1 =~ /^isbn/o);
 221                 $command = 'retrieve';
 222         }
 223
 224         if ( !grep
 225                { (keys(%$_))[0] eq $base_format }
 226                @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
 227              and !grep
 228                { $_ eq $base_format }
 229                qw/opac html htmlholdings/
 230         ) {
 231                 print "Content-type: text/html; charset=utf-8\n\n";
 232                 $apache->custom_response( 406, <<"              HTML");
 233                 <html>
 234                         <head>
 235                                 <title>Invalid format [$format] for type [$type]!</title>
 236                         </head>
 237                         <body>
 238                                 <br/>
 239                                 <center>Sorry, format $format is not valid for type $type.</center>
 240                         </body>
 241                 </html>
 242                 HTML
 243                 return 406;
 244         }
 245
 246         if ($format eq 'opac') {
 247                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 248                         if ($type eq 'metarecord');
 249                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 250                         if ($type eq 'record');
 251                 return 302;
 252         } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
 253                 my $feed = create_record_feed(
 254                         $type,
 255                         $format => [ $id ],
 256                         $base,
 257                         $lib,
 258                         $flesh_feed
 259                 );
 260
 261                 if (!$feed->count) {
 262                         print "Content-type: text/html; charset=utf-8\n\n";
 263                         $apache->custom_response( 404, <<"                      HTML");
 264                         <html>
 265                                 <head>
 266                                         <title>Type [$type] with id [$id] not found!</title>
 267                                 </head>
 268                                 <body>
 269                                         <br/>
 270                                         <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 271                                 </body>
 272                         </html>
 273                         HTML
 274                         return 404;
 275                 }
 276
 277                 $feed->root($root);
 278                 $feed->creator($host);
 279                 $feed->update_ts(gmtime_ISO8601());
 280                 $feed->link( unapi => $base) if ($flesh_feed);
 281
 282                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 283                 print entityize($feed->toString) . "\n";
 284
 285                 return Apache2::Const::OK;
 286         }
 287
 288         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 289         my $data = $req->gather(1);
 290
 291         if ($req->failed || !$data) {
 292                 print "Content-type: text/html; charset=utf-8\n\n";
 293                 $apache->custom_response( 404, <<"              HTML");
 294                 <html>
 295                         <head>
 296                                 <title>$type $id not found!</title>
 297                         </head>
 298                         <body>
 299                                 <br/>
 300                                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 301                         </body>
 302                 </html>
 303                 HTML
 304                 return 404;
 305         }
 306
 307         print "Content-type: application/xml; charset=utf-8\n\n$data";
 308
 309         return Apache2::Const::OK;
 310 }
 311
 312 sub supercat {
 313
 314         my $apache = shift;
 315         return Apache2::Const::DECLINED if (-e $apache->filename);
 316
 317         my $cgi = new CGI;
 318
 319         my $add_path = 0;
 320         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 321                 my $rel_name = $cgi->url(-relative=>1);
 322                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 323         }
 324
 325         my $url = $cgi->url(-path_info=>$add_path);
 326         my $root = (split 'supercat', $url)[0];
 327         my $base = (split 'supercat', $url)[0] . 'supercat';
 328         my $unapi = (split 'supercat', $url)[0] . 'unapi';
 329
 330         my $host = $cgi->virtual_host || $cgi->server_name;
 331
 332         my $path = $cgi->path_info;
 333         my ($id,$type,$format,$command) = reverse split '/', $path;
 334         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 335         (my $base_format = $format) =~ s/-full$//o;
 336
 337         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 338                 print "Content-type: application/xml; charset=utf-8\n";
 339                 if ($1) {
 340                         my $list = $supercat
 341                                 ->request("open-ils.supercat.$1.formats")
 342                                 ->gather(1);
 343
 344                         print "\n";
 345
 346                         print "<formats>
 347                                    <format>
 348                                      <name>opac</name>
 349                                      <type>text/html</type>
 350                                    </format>";
 351
 352                         if ($1 eq 'record' or $1 eq 'isbn') {
 353                                 print "<format>
 354                                      <name>htmlholdings</name>
 355                                      <type>text/html</type>
 356                                    </format>
 357                                    <format>
 358                                      <name>html</name>
 359                                      <type>text/html</type>
 360                                    </format>
 361                                    <format>
 362                                      <name>htmlholdings-full</name>
 363                                      <type>text/html</type>
 364                                    </format>
 365                                    <format>
 366                                      <name>html-full</name>
 367                                      <type>text/html</type>
 368                                    </format>";
 369                         }
 370
 371                         for my $h (@$list) {
 372                                 my ($type) = keys %$h;
 373                                 print "<format><name>$type</name><type>application/xml</type>";
 374
 375                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 376                                         print "<$part>$$h{$type}{$part}</$part>"
 377                                                 if ($$h{$type}{$part});
 378                                 }
 379
 380                                 print '</format>';
 381
 382                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 383                                         print "<format><name>$type-full</name><type>application/xml</type>";
 384
 385                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 386                                                 print "<$part>$$h{$type}{$part}</$part>"
 387                                                         if ($$h{$type}{$part});
 388                                         }
 389
 390                                         print '</format>';
 391                                 }
 392
 393                         }
 394
 395                         print "</formats>\n";
 396
 397                         return Apache2::Const::OK;
 398                 }
 399
 400                 my $list = $supercat
 401                         ->request("open-ils.supercat.record.formats")
 402                         ->gather(1);
 403
 404                 push @$list,
 405                         @{ $supercat
 406                                 ->request("open-ils.supercat.metarecord.formats")
 407                                 ->gather(1);
 408                         };
 409
 410                 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 411                 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 412
 413                 print "\n<formats>
 414                            <format>
 415                              <name>opac</name>
 416                              <type>text/html</type>
 417                            </format>
 418                            <format>
 419                              <name>htmlholdings</name>
 420                              <type>text/html</type>
 421                            </format>
 422                            <format>
 423                              <name>html</name>
 424                              <type>text/html</type>
 425                            </format>
 426                            <format>
 427                              <name>htmlholdings-full</name>
 428                              <type>text/html</type>
 429                            </format>
 430                            <format>
 431                              <name>html-full</name>
 432                              <type>text/html</type>
 433                            </format>";
 434
 435                 for my $h (@$list) {
 436                         my ($type) = keys %$h;
 437                         print "<format><name>$type</name><type>application/xml</type>";
 438
 439                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 440                                 print "<$part>$$h{$type}{$part}</$part>"
 441                                         if ($$h{$type}{$part});
 442                         }
 443
 444                         print '</format>';
 445
 446                         if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 447                                 print "<format><name>$type-full</name><type>application/xml</type>";
 448
 449                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 450                                         print "<$part>$$h{$type}{$part}</$part>"
 451                                                 if ($$h{$type}{$part});
 452                                 }
 453
 454                                 print '</format>';
 455                         }
 456
 457                 }
 458
 459                 print "</formats>\n";
 460
 461
 462                 return Apache2::Const::OK;
 463         }
 464
 465         if ($format eq 'opac') {
 466                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 467                         if ($type eq 'metarecord');
 468                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 469                         if ($type eq 'record');
 470                 return 302;
 471         } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
 472                 my $feed = create_record_feed(
 473                         $type,
 474                         $format => [ $id ],
 475                         undef, undef,
 476                         $flesh_feed
 477                 );
 478
 479                 $feed->root($root);
 480                 $feed->creator($host);
 481                 $feed->update_ts(gmtime_ISO8601());
 482                 $feed->link( unapi => $base) if ($flesh_feed);
 483
 484                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 485                 print entityize($feed->toString) . "\n";
 486
 487                 return Apache2::Const::OK;
 488         }
 489
 490         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 491         $req->wait_complete;
 492
 493         if ($req->failed) {
 494                 print "Content-type: text/html; charset=utf-8\n\n";
 495                 $apache->custom_response( 404, <<"              HTML");
 496                 <html>
 497                         <head>
 498                                 <title>$type $id not found!</title>
 499                         </head>
 500                         <body>
 501                                 <br/>
 502                                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 503                         </body>
 504                 </html>
 505                 HTML
 506                 return 404;
 507         }
 508
 509         print "Content-type: application/xml; charset=utf-8\n\n";
 510         print entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
 511
 512         return Apache2::Const::OK;
 513 }
 514
 515
 516 sub bookbag_feed {
 517         my $apache = shift;
 518         return Apache2::Const::DECLINED if (-e $apache->filename);
 519
 520         my $cgi = new CGI;
 521
 522         my $year = (gmtime())[5] + 1900;
 523         my $host = $cgi->virtual_host || $cgi->server_name;
 524
 525         my $add_path = 0;
 526         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 527                 my $rel_name = $cgi->url(-relative=>1);
 528                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 529         }
 530
 531         my $url = $cgi->url(-path_info=>$add_path);
 532         my $root = (split 'feed', $url)[0];
 533         my $base = (split 'bookbag', $url)[0] . 'bookbag';
 534         my $unapi = (split 'feed', $url)[0] . 'unapi';
 535
 536
 537         my $path = $cgi->path_info;
 538         #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
 539
 540         my ($id,$type) = reverse split '/', $path;
 541         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 542
 543         my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
 544         return Apache2::Const::NOT_FOUND unless($bucket);
 545
 546         my $bucket_tag = "tag:$host,$year:record_bucket/$id";
 547         if ($type eq 'opac') {
 548                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 549                         join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
 550                         "\n\n";
 551                 return 302;
 552         }
 553
 554         my $feed = create_record_feed(
 555                 'record',
 556                 $type,
 557                 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
 558                 $unapi,
 559                 undef,
 560                 $flesh_feed
 561         );
 562         $feed->root($root);
 563
 564         $feed->title("Items in Book Bag [".$bucket->name."]");
 565         $feed->creator($host);
 566         $feed->update_ts(gmtime_ISO8601());
 567
 568         $feed->link(rss => $base . "/rss2/$id" => 'application/rss+xml');
 569         $feed->link(alternate => $base . "/atom/$id" => 'application/atom+xml');
 570         $feed->link(html => $base . "/html/$id" => 'text/html');
 571         $feed->link(unapi => $unapi);
 572
 573         $feed->link(
 574                 OPAC =>
 575                 '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 576                         join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
 577                 'text/html'
 578         );
 579
 580
 581         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 582         print entityize($feed->toString) . "\n";
 583
 584         return Apache2::Const::OK;
 585 }
 586
 587 sub changes_feed {
 588         my $apache = shift;
 589         return Apache2::Const::DECLINED if (-e $apache->filename);
 590
 591         my $cgi = new CGI;
 592
 593         my $year = (gmtime())[5] + 1900;
 594         my $host = $cgi->virtual_host || $cgi->server_name;
 595
 596         my $add_path = 0;
 597         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 598                 my $rel_name = $cgi->url(-relative=>1);
 599                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 600         }
 601
 602         my $url = $cgi->url(-path_info=>$add_path);
 603         my $root = (split 'feed', $url)[0];
 604         my $base = (split 'freshmeat', $url)[0] . 'freshmeat';
 605         my $unapi = (split 'feed', $url)[0] . 'unapi';
 606
 607         my $path = $cgi->path_info;
 608         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 609
 610         $path =~ s/^\/(?:feed\/)?freshmeat\///og;
 611
 612         my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
 613         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 614         $limit ||= 10;
 615
 616         my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
 617
 618         #if ($type eq 'opac') {
 619         #       print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 620         #               join('&', map { "rl=" . $_ } @$list) .
 621         #               "\n\n";
 622         #       return 302;
 623         #}
 624
 625         my $feed = create_record_feed( 'record', $type, $list, $unapi, undef, $flesh_feed);
 626         $feed->root($root);
 627
 628         if ($date) {
 629                 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
 630         } else {
 631                 $feed->title("$limit most recent $rtype ${axis}s");
 632         }
 633
 634         $feed->creator($host);
 635         $feed->update_ts(gmtime_ISO8601());
 636
 637         $feed->link(rss => $base . "/rss2/$rtype/$axis/$limit/$date" => 'application/rss+xml');
 638         $feed->link(alternate => $base . "/atom/$rtype/$axis/$limit/$date" => 'application/atom+xml');
 639         $feed->link(html => $base . "/html/$rtype/$axis/$limit/$date" => 'text/html');
 640         $feed->link(unapi => $unapi);
 641
 642         $feed->link(
 643                 OPAC =>
 644                 '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 645                         join('&', map { 'rl=' . $_} @$list ),
 646                 'text/html'
 647         );
 648
 649
 650         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 651         print entityize($feed->toString) . "\n";
 652
 653         return Apache2::Const::OK;
 654 }
 655
 656 sub opensearch_osd {
 657         my $version = shift;
 658         my $lib = shift;
 659         my $class = shift;
 660         my $base = shift;
 661
 662         if ($version eq '1.0') {
 663                 print <<OSD;
 664 Content-type: application/opensearchdescription+xml; charset=utf-8
 665
 666 <?xml version="1.0" encoding="UTF-8"?>
 667 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
 668   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
 669   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
 670   <ShortName>$lib</ShortName>
 671   <LongName>Search $lib</LongName>
 672   <Description>Search the $lib OPAC by $class.</Description>
 673   <Tags>$lib book library</Tags>
 674   <SampleSearch>harry+potter</SampleSearch>
 675   <Developer>Mike Rylander for GPLS/PINES</Developer>
 676   <Contact>feedback\@open-ils.org</Contact>
 677   <SyndicationRight>open</SyndicationRight>
 678   <AdultContent>false</AdultContent>
 679 </OpenSearchDescription>
 680 OSD
 681         } else {
 682                 print <<OSD;
 683 Content-type: application/opensearchdescription+xml; charset=utf-8
 684
 685 <?xml version="1.0" encoding="UTF-8"?>
 686 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
 687   <ShortName>$lib</ShortName>
 688   <Description>Search the $lib OPAC by $class.</Description>
 689   <Tags>$lib book library</Tags>
 690   <Url type="application/rss+xml"
 691        template="$base/1.1/$lib/rss2/$class/?searchTerms={searchTerms}&startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 692   <Url type="application/atom+xml"
 693        template="$base/1.1/$lib/atom/$class/?searchTerms={searchTerms}&startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 694   <Url type="application/x-mods3+xml"
 695        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 696   <Url type="application/x-mods+xml"
 697        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 698   <Url type="application/x-marcxml+xml"
 699        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 700   <LongName>Search $lib</LongName>
 701   <Query role="example" searchTerms="harry+potter" />
 702   <Developer>Mike Rylander for GPLS/PINES</Developer>
 703   <Contact>feedback\@open-ils.org</Contact>
 704   <SyndicationRight>open</SyndicationRight>
 705   <AdultContent>false</AdultContent>
 706   <Language>en-US</Language>
 707   <OutputEncoding>UTF-8</OutputEncoding>
 708   <InputEncoding>UTF-8</InputEncoding>
 709 </OpenSearchDescription>
 710 OSD
 711         }
 712
 713         return Apache2::Const::OK;
 714 }
 715
 716 sub opensearch_feed {
 717         my $apache = shift;
 718         return Apache2::Const::DECLINED if (-e $apache->filename);
 719
 720         my $cgi = new CGI;
 721         my $year = (gmtime())[5] + 1900;
 722
 723         my $host = $cgi->virtual_host || $cgi->server_name;
 724
 725         my $add_path = 0;
 726         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 727                 my $rel_name = $cgi->url(-relative=>1);
 728                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 729         }
 730
 731         my $url = $cgi->url(-path_info=>$add_path);
 732         my $root = (split 'opensearch', $url)[0];
 733         my $base = (split 'opensearch', $url)[0] . 'opensearch';
 734         my $unapi = (split 'opensearch', $url)[0] . 'unapi';
 735
 736         my $path = $cgi->path_info;
 737         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 738
 739         if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
 740
 741                 my $version = $1;
 742                 my $lib = $2;
 743                 my $class = $3;
 744
 745                 if (!$lib) {
 746                         $lib = $actor->request(
 747                                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
 748                         )->gather(1)->[0]->shortname;
 749                 }
 750
 751                 if ($class eq '-') {
 752                         $class = 'keyword';
 753                 }
 754
 755                 return opensearch_osd($version, $lib, $class, $base);
 756         }
 757
 758
 759         my $page = $cgi->param('startPage') || 1;
 760         my $offset = $cgi->param('startIndex') || 1;
 761         my $limit = $cgi->param('count') || 10;
 762
 763         $page = 1 if ($page !~ /^\d+$/);
 764         $offset = 1 if ($offset !~ /^\d+$/);
 765         $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
 766
 767         if ($page > 1) {
 768                 $offset = ($page - 1) * $limit;
 769         } else {
 770                 $offset -= 1;
 771         }
 772
 773         my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang);
 774         (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
 775
 776         $lang ||= $cgi->param('searchLang');
 777         $sort ||= $cgi->param('searchSort');
 778         $sortdir ||= $cgi->param('searchSortDir');
 779         $terms ||= $cgi->param('searchTerms');
 780         $class ||= $cgi->param('searchClass') || '-';
 781         $type ||= $cgi->param('responseType') || '-';
 782         $org ||= $cgi->param('searchOrg') || '-';
 783
 784         if ($version eq '1.0') {
 785                 $type = 'rss2';
 786         } elsif ($type eq '-') {
 787                 $type = 'atom';
 788         }
 789         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 790
 791         $terms = decode_utf8($terms);
 792         $terms =~ s/\+/ /go;
 793         $terms =~ s/'//go;
 794         my $term_copy = $terms;
 795
 796         my $complex_terms = 0;
 797         if ($terms eq 'help') {
 798                 print $cgi->header(-type => 'text/html');
 799                 print <<"               HTML";
 800                         <html>
 801                          <head>
 802                           <title>just type something!</title>
 803                          </head>
 804                          <body>
 805                           <p>You are in a maze of dark, twisty stacks, all alike.</p>
 806                          </body>
 807                         </html>
 808                 HTML
 809                 return Apache2::Const::OK;
 810         }
 811
 812         my $cache_key = '';
 813         my $searches = {};
 814         while ($term_copy =~ s/((?:keyword|title|author|subject|series|site|dir|sort|lang):[^:]+)$//so) {
 815                 my ($c,$t) = split ':' => $1;
 816                 if ($c eq 'site') {
 817                         $org = $t;
 818                         $org =~ s/^\s*//o;
 819                         $org =~ s/\s*$//o;
 820                 } elsif ($c eq 'sort') {
 821                         ($sort = lc($t)) =~ s/^\s*(\w+)\s*$/$1/go;
 822                 } elsif ($c eq 'dir') {
 823                         ($sortdir = lc($t)) =~ s/^\s*(\w+)\s*$/$1/go;
 824                 } elsif ($c eq 'lang') {
 825                         ($lang = lc($t)) =~ s/^\s*(\w+)\s*$/$1/go;
 826                 } else {
 827                         $$searches{$c}{term} .= ' '.$t;
 828                         $cache_key .= $c . $t;
 829                         $complex_terms = 1;
 830                 }
 831         }
 832
 833         if ($term_copy) {
 834                 no warnings;
 835                 $class = 'keyword' if ($class eq '-');
 836                 $$searches{$class}{term} .= " $term_copy";
 837                 $cache_key .= $class . $term_copy;
 838         }
 839
 840         my $org_unit;
 841         if ($org eq '-') {
 842                 $org_unit = $actor->request(
 843                         'open-ils.actor.org_unit_list.search' => parent_ou => undef
 844                 )->gather(1);
 845         } else {
 846                 $org_unit = $actor->request(
 847                         'open-ils.actor.org_unit_list.search' => shortname => uc($org)
 848                 )->gather(1);
 849         }
 850
 851         $cache_key .= $org.$sort.$sortdir.$lang;
 852
 853         my $rs_name = $cgi->cookie('os_session');
 854         my $cached_res = OpenSRF::Utils::Cache->new->get_cache( "os_session:$rs_name" ) if ($rs_name);
 855
 856         my $recs;
 857         if (!($recs = $$cached_res{os_results}{$cache_key})) {
 858                 $rs_name = $cgi->remote_host . '::' . rand(time);
 859                 $recs = $search->request(
 860                         'open-ils.search.biblio.multiclass' => {
 861                                 searches        => $searches,
 862                                 org_unit        => $org_unit->[0]->id,
 863                                 offset          => 0,
 864                                 limit           => 5000,
 865                                 ($sort ?    ( 'sort'     => $sort    ) : ()),
 866                                 ($sortdir ? ( 'sort_dir' => $sortdir ) : ($sort ? (sort_dir => 'asc') : (sort_dir => 'desc') )),
 867                                 ($lang ?    ( 'language' => $lang    ) : ()),
 868                         }
 869                 )->gather(1);
 870                 try {
 871                         $$cached_res{os_results}{$cache_key} = $recs;
 872                         OpenSRF::Utils::Cache->new->put_cache( "os_session:$rs_name", $cached_res, 1800 );
 873                 } catch Error with {
 874                         warn "supercat unable to store IDs in memcache server\n";
 875                         $logger->error("supercat unable to store IDs in memcache server");
 876                 };
 877         }
 878
 879         my $feed = create_record_feed(
 880                 'record',
 881                 $type,
 882                 [ map { $_->[0] } @{$recs->{ids}}[$offset .. $offset + $limit - 1] ],
 883                 $unapi,
 884                 $org,
 885                 $flesh_feed
 886         );
 887         $feed->root($root);
 888         $feed->lib($org);
 889         $feed->search($terms);
 890         $feed->class($class);
 891
 892         if ($complex_terms) {
 893                 $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
 894         } else {
 895                 $feed->title("Search results for [$class => $terms] at ".$org_unit->[0]->name);
 896         }
 897
 898         $feed->creator($host);
 899         $feed->update_ts(gmtime_ISO8601());
 900
 901         $feed->_create_node(
 902                 $feed->{item_xpath},
 903                 'http://a9.com/-/spec/opensearch/1.1/',
 904                 'totalResults',
 905                 $recs->{count},
 906         );
 907
 908         $feed->_create_node(
 909                 $feed->{item_xpath},
 910                 'http://a9.com/-/spec/opensearch/1.1/',
 911                 'startIndex',
 912                 $offset + 1,
 913         );
 914
 915         $feed->_create_node(
 916                 $feed->{item_xpath},
 917                 'http://a9.com/-/spec/opensearch/1.1/',
 918                 'itemsPerPage',
 919                 $limit,
 920         );
 921
 922         $feed->link(
 923                 next =>
 924                 $base . "/$version/$org/$type/$class?searchTerms=$terms&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
 925                 'application/opensearch+xml'
 926         ) if ($offset + $limit < $recs->{count});
 927
 928         $feed->link(
 929                 previous =>
 930                 $base . "/$version/$org/$type/$class?searchTerms=$terms&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
 931                 'application/opensearch+xml'
 932         ) if ($offset);
 933
 934         $feed->link(
 935                 self =>
 936                 $base .  "/$version/$org/$type/$class?searchTerms=$terms" =>
 937                 'application/opensearch+xml'
 938         );
 939
 940         $feed->link(
 941                 rss =>
 942                 $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms" =>
 943                 'application/rss+xml'
 944         );
 945
 946         $feed->link(
 947                 alternate =>
 948                 $base .  "/$version/$org/atom-full/$class?searchTerms=$terms" =>
 949                 'application/atom+xml'
 950         );
 951
 952         $feed->link(
 953                 'html' =>
 954                 $base .  "/$version/$org/html/$class?searchTerms=$terms" =>
 955                 'text/html'
 956         );
 957
 958         $feed->link(
 959                 'html-full' =>
 960                 $base .  "/$version/$org/html-full/$class?searchTerms=$terms" =>
 961                 'text/html'
 962         );
 963
 964         $feed->link( 'unapi-server' => $unapi);
 965
 966 #       $feed->link(
 967 #               opac =>
 968 #               $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
 969 #                       join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
 970 #               'text/html'
 971 #       );
 972
 973         print $cgi->header(
 974                 -type           => $feed->type,
 975                 -charset        => 'UTF-8',
 976                 -cookie         => $cgi->cookie( -name => 'os_session', -value => $rs_name, -expires => '+30m' ),
 977         );
 978
 979         print entityize($feed->toString) . "\n";
 980
 981         return Apache2::Const::OK;
 982 }
 983
 984 sub create_record_feed {
 985         my $search = shift;
 986         my $type = shift;
 987         my $records = shift;
 988         my $unapi = shift;
 989
 990         my $lib = shift || '-';
 991         my $flesh = shift;
 992         $flesh = 1 if (!defined($flesh));
 993
 994         my $cgi = new CGI;
 995         my $base = $cgi->url;
 996         my $host = $cgi->virtual_host || $cgi->server_name;
 997
 998         my $year = (gmtime())[5] + 1900;
 999
1000         my $flesh_feed = ($type =~ s/-full$//o) ? 1 : 0;
1001
1002         my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1003         $feed->base($base) if ($flesh);
1004         $feed->unapi($unapi) if ($flesh);
1005
1006         $type = 'atom' if ($type eq 'html');
1007         $type = 'marcxml' if ($type eq 'htmlholdings');
1008
1009         #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1010
1011         my $count = 0;
1012         for my $record (@$records) {
1013                 next unless($record);
1014
1015                 #my $rec = $record->id;
1016                 my $rec = $record;
1017
1018                 my $item_tag = "tag:$host,$year:biblio-record_entry/$rec/$lib";
1019                 $item_tag = "tag:$host,$year:isbn/$rec/$lib" if ($search eq 'isbn');
1020
1021                 my $xml = $supercat->request(
1022                         "open-ils.supercat.$search.$type.retrieve",
1023                         $rec
1024                 )->gather(1);
1025                 next unless $xml;
1026
1027                 my $node = $feed->add_item($xml);
1028                 next unless $node;
1029
1030                 if ($lib && $type eq 'marcxml' &&  $flesh) {
1031                         $xml = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib )->gather(1);
1032                         $node->add_holdings($xml);
1033                 }
1034
1035                 $node->id($item_tag) if ($flesh);
1036                 #$node->update_ts(clense_ISO8601($record->edit_date));
1037                 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh);
1038                 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh);
1039                 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1040                 $node->link('unapi-id' => $item_tag) if ($flesh);
1041         }
1042
1043         return $feed;
1044 }
1045
1046 sub entityize {
1047         my $stuff = NFC(shift());
1048         $stuff =~ s/&(?!\S+;)/&amp;/gso;
1049         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
1050         return $stuff;
1051 }
1052
1053 my %browse_types = (
1054         call_number => {
1055                 xml => sub {
1056                         my $tree = shift;
1057
1058                         my $year = (gmtime())[5] + 1900;
1059                         my $content = '';
1060
1061                         $content .= "Content-type: application/xml\n\n";
1062                         $content .= "<hold:volumes  xmlns:hold='http://open-ils.org/spec/holdings/v1'>";
1063
1064                         for my $cn (@$tree) {
1065                                 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
1066                                 $cn_class =~ s/Fieldmapper-//gso;
1067
1068                                 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
1069                                 my $cn_lib = $cn->owning_lib->shortname;
1070                                 my $cn_label = $cn->label;
1071
1072                                 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
1073                                 $ou_class =~ s/Fieldmapper-//gso;
1074
1075                                 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
1076                                 my $ou_name = $cn->owning_lib->name;
1077
1078                                 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
1079                                 $rec_class =~ s/Fieldmapper-//gso;
1080
1081                                 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
1082
1083                                 $content .= "<hold:volume id='$cn_tag' lib='$cn_lib' label='$cn_label'>";
1084                                 $content .= "<act:owning_lib xmlns:act='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>";
1085
1086                                 my $r_doc = $parser->parse_string($cn->record->marc);
1087                                 $r_doc->documentElement->setAttribute( id => $rec_tag );
1088                                 $content .= entityize($r_doc->documentElement->toString);
1089
1090                                 $content .= "</hold:volume>";
1091                         }
1092
1093                         $content .= '</hold:volumes>';
1094                         return $content;
1095                 }
1096         }
1097
1098 );
1099 sub string_browse {
1100         my $apache = shift;
1101         return Apache2::Const::DECLINED if (-e $apache->filename);
1102
1103         my $cgi = new CGI;
1104         my $year = (gmtime())[5] + 1900;
1105
1106         my $host = $cgi->virtual_host || $cgi->server_name;
1107
1108         my $add_path = 0;
1109         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1110                 my $rel_name = $cgi->url(-relative=>1);
1111                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1112         }
1113
1114         my $url = $cgi->url(-path_info=>$add_path);
1115         my $root = (split 'browse', $url)[0];
1116         my $base = (split 'browse', $url)[0] . 'browse';
1117         my $unapi = (split 'browse', $url)[0] . 'unapi';
1118
1119         my $path = $cgi->path_info;
1120         $path =~ s/^\///og;
1121
1122         my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1123         #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1124
1125
1126         $site ||= $cgi->param('searchOrg');
1127         $page ||= $cgi->param('startPage') || 0;
1128         $page_size ||= $cgi->param('count') || 9;
1129
1130         $page = 0 if ($page !~ /^\d+$/);
1131
1132         unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1133                 warn "something's wrong...";
1134                 warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1135                 return undef;
1136         }
1137
1138         $string = decode_utf8($string);
1139         $string =~ s/\+/ /go;
1140         $string =~ s/'//go;
1141
1142         my $tree = $supercat->request(
1143                 "open-ils.supercat.$axis.browse",
1144                 $string,
1145                 $site,
1146                 $page_size,
1147                 $page
1148         )->gather(1);
1149
1150         my $content = $browse_types{$axis}{$format}->($tree);
1151         print $content;
1152         return Apache2::Const::OK;
1153 }
1154
1155 1;