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