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