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