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