Open-ILS/src/perlmods/OpenILS/WWW/SuperCat.pm

   1 package OpenILS::WWW::SuperCat;
   2 use strict; use warnings;
   3
   4 use Apache2::Log;
   5 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
   6 use APR::Const    -compile => qw(:error SUCCESS);
   7 use Apache2::RequestRec ();
   8 use Apache2::RequestIO ();
   9 use Apache2::RequestUtil;
  10 use CGI;
  11 use Data::Dumper;
  12 use SRU::Request;
  13 use SRU::Response;
  14
  15 use OpenSRF::EX qw(:try);
  16 use OpenSRF::Utils qw/:datetime/;
  17 use OpenSRF::Utils::Cache;
  18 use OpenSRF::System;
  19 use OpenSRF::AppSession;
  20 use XML::LibXML;
  21 use XML::LibXSLT;
  22
  23 use Encode;
  24 use Unicode::Normalize;
  25 use OpenILS::Utils::Fieldmapper;
  26 use OpenILS::WWW::SuperCat::Feed;
  27 use OpenSRF::Utils::Logger qw/$logger/;
  28
  29 use MARC::Record;
  30 use MARC::File::XML;
  31
  32 my $log = 'OpenSRF::Utils::Logger';
  33
  34 # set the bootstrap config when this module is loaded
  35 my ($bootstrap, $cstore, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types);
  36
  37 $browse_types{call_number}{xml} = sub {
  38         my $tree = shift;
  39
  40         my $year = (gmtime())[5] + 1900;
  41         my $content = '';
  42
  43         $content .= "<hold:volumes  xmlns:hold='http://open-ils.org/spec/holdings/v1'>";
  44
  45         for my $cn (@$tree) {
  46                 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
  47                 $cn_class =~ s/Fieldmapper-//gso;
  48
  49                 my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
  50                 my $cn_lib = $cn->owning_lib->shortname;
  51                 my $cn_label = $cn->label;
  52
  53                 $cn_label =~ s/\n//gos;
  54                 $cn_label =~ s/'/&apos;/go;
  55
  56                 (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
  57                 $ou_class =~ s/Fieldmapper-//gso;
  58
  59                 my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
  60                 my $ou_name = $cn->owning_lib->name;
  61
  62                 $ou_name =~ s/\n//gos;
  63                 $ou_name =~ s/'/&apos;/go;
  64
  65                 (my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
  66                 $rec_class =~ s/Fieldmapper-//gso;
  67
  68                 my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
  69
  70                 $content .= "<hold:volume id='$cn_tag' lib='$cn_lib' label='$cn_label'>";
  71                 $content .= "<act:owning_lib xmlns:act='http://open-ils.org/spec/actors/v1' id='$ou_tag' name='$ou_name'/>";
  72
  73                 my $r_doc = $parser->parse_string($cn->record->marc);
  74                 $r_doc->documentElement->setAttribute( id => $rec_tag );
  75                 $content .= entityize($r_doc->documentElement->toString);
  76
  77                 $content .= "</hold:volume>";
  78         }
  79
  80         $content .= '</hold:volumes>';
  81         return ("Content-type: application/xml\n\n",$content);
  82 };
  83
  84
  85 $browse_types{call_number}{html} = sub {
  86         my $tree = shift;
  87         my $p = shift;
  88         my $n = shift;
  89
  90         if (!$cn_browse_xslt) {
  91                 $cn_browse_xslt = $parser->parse_file(
  92                         OpenSRF::Utils::SettingsClient
  93                                 ->new
  94                                 ->config_value( dirs => 'xsl' ).
  95                         "/CNBrowse2HTML.xsl"
  96                 );
  97                 $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
  98         }
  99
 100         my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
 101
 102         return (
 103                 "Content-type: text/html\n\n",
 104                 entityize(
 105                         $cn_browse_xslt->transform(
 106                                 $parser->parse_string( $xml ),
 107                                 'prev' => "'$p'",
 108                                 'next' => "'$n'"
 109                         )->toString(1)
 110                 )
 111         );
 112 };
 113
 114 sub import {
 115         my $self = shift;
 116         $bootstrap = shift;
 117 }
 118
 119
 120 sub child_init {
 121         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
 122
 123         my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
 124         Fieldmapper->import(IDL => $idl);
 125
 126         $supercat = OpenSRF::AppSession->create('open-ils.supercat');
 127         $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 128         $actor = OpenSRF::AppSession->create('open-ils.actor');
 129         $search = OpenSRF::AppSession->create('open-ils.search');
 130         $parser = new XML::LibXML;
 131         $xslt = new XML::LibXSLT;
 132
 133         $cn_browse_xslt = $parser->parse_file(
 134                 OpenSRF::Utils::SettingsClient
 135                         ->new
 136                         ->config_value( dirs => 'xsl' ).
 137                 "/CNBrowse2HTML.xsl"
 138         );
 139
 140         $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
 141
 142         my $list = $supercat
 143                 ->request("open-ils.supercat.record.formats")
 144                 ->gather(1);
 145
 146     $list = [ map { (keys %$_)[0] } @$list ];
 147     push @$list, 'htmlholdings','html';
 148
 149     for my $browse_axis ( qw/title author subject topic series/ ) {
 150         for my $record_browse_format ( @$list ) {
 151             {
 152                 my $__f = $record_browse_format;
 153                 my $__a = $browse_axis;
 154
 155                 $browse_types{$__a}{$__f} = sub {
 156                         my $record_list = shift;
 157                         my $prev = shift;
 158                         my $next = shift;
 159                         my $real_format = shift || $__f;
 160                         my $unapi = shift;
 161                         my $base = shift;
 162                         my $site = shift;
 163
 164                         my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, $real_format =~ /-full$/o ? 1 : 0 );
 165                         $feed->root( "$base/../" );
 166                         $feed->lib( $site );
 167                         $feed->link( next => $next => $feed->type );
 168                         $feed->link( previous => $prev => $feed->type );
 169
 170                         return (
 171                         "Content-type: ". $feed->type ."; charset=utf-8\n\n",
 172                         $feed->toString
 173                     );
 174                 };
 175             }
 176         }
 177     }
 178 }
 179
 180 sub oisbn {
 181
 182         my $apache = shift;
 183         return Apache2::Const::DECLINED if (-e $apache->filename);
 184
 185         (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
 186
 187         my $list = $supercat
 188                 ->request("open-ils.supercat.oisbn", $isbn)
 189                 ->gather(1);
 190
 191         print "Content-type: application/xml; charset=utf-8\n\n";
 192         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
 193
 194         unless (exists $$list{metarecord}) {
 195                 print '<idlist/>';
 196                 return Apache2::Const::OK;
 197         }
 198
 199         print "<idlist metarecord='$$list{metarecord}'>\n";
 200
 201         for ( keys %{ $$list{record_list} } ) {
 202                 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
 203                 print "  <isbn record='$_'>$o</isbn>\n"
 204         }
 205
 206         print "</idlist>\n";
 207
 208         return Apache2::Const::OK;
 209 }
 210
 211 sub unapi {
 212
 213         my $apache = shift;
 214         return Apache2::Const::DECLINED if (-e $apache->filename);
 215
 216         my $cgi = new CGI;
 217
 218         my $add_path = 0;
 219         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 220                 my $rel_name = $cgi->url(-relative=>1);
 221                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 222         }
 223
 224         my $url = $cgi->url(-path_info=>$add_path);
 225         my $root = (split 'unapi', $url)[0];
 226         my $base = (split 'unapi', $url)[0] . 'unapi';
 227
 228
 229         my $uri = $cgi->param('id') || '';
 230         my $host = $cgi->virtual_host || $cgi->server_name;
 231
 232         my $format = $cgi->param('format');
 233         my $flesh_feed = ($format =~ /-full$/o) ? 1 : 0;
 234         (my $base_format = $format) =~ s/-full$//o;
 235         my ($id,$type,$command,$lib) = ('','','');
 236
 237         if (!$format) {
 238                 my $body = "Content-type: application/xml; charset=utf-8\n\n";
 239
 240                 if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^/]+)(?:/(.+))$}o) {
 241                         $id = $2;
 242                         $lib = uc($3);
 243                         $type = 'record';
 244                         $type = 'metarecord' if ($1 =~ /^m/o);
 245
 246                         my $list = $supercat
 247                                 ->request("open-ils.supercat.$type.formats")
 248                                 ->gather(1);
 249
 250                         if ($type eq 'record' or $type eq 'isbn') {
 251                                 $body .= <<"                            FORMATS";
 252 <formats id='$uri'>
 253         <format name='opac' type='text/html'/>
 254         <format name='html' type='text/html'/>
 255         <format name='htmlholdings' type='text/html'/>
 256         <format name='html-full' type='text/html'/>
 257         <format name='htmlholdings-full' type='text/html'/>
 258                                 FORMATS
 259                         } elsif ($type eq 'metarecord') {
 260                                 $body .= <<"                            FORMATS";
 261                                 <formats id='$uri'>
 262                                         <format name='opac' type='text/html'/>
 263                                 FORMATS
 264                         }
 265
 266                         for my $h (@$list) {
 267                                 my ($type) = keys %$h;
 268                                 $body .= "\t<format name='$type' type='application/xml'";
 269
 270                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 271                                         $body .= " $part='$$h{$type}{$part}'"
 272                                                 if ($$h{$type}{$part});
 273                                 }
 274
 275                                 $body .= "/>\n";
 276
 277                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 278                                         $body .= "\t<format name='$type-full' type='application/xml'";
 279
 280                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 281                                                 $body .= " $part='$$h{$type}{$part}'"
 282                                                         if ($$h{$type}{$part});
 283                                         }
 284
 285                                         $body .= "/>\n";
 286                                 }
 287                         }
 288
 289                         $body .= "</formats>\n";
 290
 291                 } else {
 292                         my $list = $supercat
 293                                 ->request("open-ils.supercat.record.formats")
 294                                 ->gather(1);
 295
 296                         push @$list,
 297                                 @{ $supercat
 298                                         ->request("open-ils.supercat.metarecord.formats")
 299                                         ->gather(1);
 300                                 };
 301
 302                         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 303                         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 304
 305                         $body .= <<"                    FORMATS";
 306 <formats>
 307         <format name='opac' type='text/html'/>
 308         <format name='html' type='text/html'/>
 309         <format name='htmlholdings' type='text/html'/>
 310         <format name='html-full' type='text/html'/>
 311         <format name='htmlholdings-full' type='text/html'/>
 312                         FORMATS
 313
 314
 315                         for my $h (@$list) {
 316                                 my ($type) = keys %$h;
 317                                 $body .= "\t<format name='$type' type='application/xml'";
 318
 319                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 320                                         $body .= " $part='$$h{$type}{$part}'"
 321                                                 if ($$h{$type}{$part});
 322                                 }
 323
 324                                 $body .= "/>\n";
 325
 326                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 327                                         $body .= "\t<format name='$type-full' type='application/xml'";
 328
 329                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 330                                                 $body .= " $part='$$h{$type}{$part}'"
 331                                                         if ($$h{$type}{$part});
 332                                         }
 333
 334                                         $body .= "/>\n";
 335                                 }
 336                         }
 337
 338                         $body .= "</formats>\n";
 339
 340                 }
 341                 print $body;
 342                 return Apache2::Const::OK;
 343         }
 344
 345         if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^/]+)(?:/(.+))?}o) {
 346                 $id = $2;
 347                 $lib = uc($3);
 348                 $type = 'record';
 349                 $type = 'metarecord' if ($1 =~ /^metabib/o);
 350                 $type = 'isbn' if ($1 =~ /^isbn/o);
 351                 $type = 'call_number' if ($1 =~ /^call_number/o);
 352                 $command = 'retrieve';
 353                 $command = 'browse' if ($type eq 'call_number');
 354         }
 355
 356         if (!$lib || $lib eq '-') {
 357                 $lib = $actor->request(
 358                         'open-ils.actor.org_unit_list.search' => parent_ou => undef
 359                 )->gather(1)->[0]->shortname;
 360         }
 361
 362         my $lib_object = $actor->request(
 363                 'open-ils.actor.org_unit_list.search' => shortname => $lib
 364         )->gather(1)->[0];
 365         my $lib_id = $lib_object->id;
 366
 367         my $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
 368         my $lib_depth = (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
 369
 370         if ($type eq 'call_number' and $command eq 'browse') {
 371                 print "Location: $root/browse/$base_format/call_number/$lib/$id\n\n";
 372                 return 302;
 373         }
 374
 375         if ($type eq 'isbn') {
 376                 my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
 377                 if (!@$rec) {
 378                         print "Content-type: text/html; charset=utf-8\n\n";
 379                         $apache->custom_response( 404, <<"                      HTML");
 380                         <html>
 381                                 <head>
 382                                         <title>Type [$type] with id [$id] not found!</title>
 383                                 </head>
 384                                 <body>
 385                                         <br/>
 386                                         <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 387                                 </body>
 388                         </html>
 389                         HTML
 390                         return 404;
 391                 }
 392                 $id = $rec->[0]->id;
 393                 $type = 'record';
 394         }
 395
 396         if ( !grep
 397                { (keys(%$_))[0] eq $base_format }
 398                @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
 399              and !grep
 400                { $_ eq $base_format }
 401                qw/opac html htmlholdings/
 402         ) {
 403                 print "Content-type: text/html; charset=utf-8\n\n";
 404                 $apache->custom_response( 406, <<"              HTML");
 405                 <html>
 406                         <head>
 407                                 <title>Invalid format [$format] for type [$type]!</title>
 408                         </head>
 409                         <body>
 410                                 <br/>
 411                                 <center>Sorry, format $format is not valid for type $type.</center>
 412                         </body>
 413                 </html>
 414                 HTML
 415                 return 406;
 416         }
 417
 418         if ($format eq 'opac') {
 419                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
 420                         if ($type eq 'metarecord');
 421                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
 422                         if ($type eq 'record');
 423                 return 302;
 424         } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
 425                 my $feed = create_record_feed(
 426                         $type,
 427                         $format => [ $id ],
 428                         $base,
 429                         $lib,
 430                         $flesh_feed
 431                 );
 432
 433                 if (!$feed->count) {
 434                         print "Content-type: text/html; charset=utf-8\n\n";
 435                         $apache->custom_response( 404, <<"                      HTML");
 436                         <html>
 437                                 <head>
 438                                         <title>Type [$type] with id [$id] not found!</title>
 439                                 </head>
 440                                 <body>
 441                                         <br/>
 442                                         <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 443                                 </body>
 444                         </html>
 445                         HTML
 446                         return 404;
 447                 }
 448
 449                 $feed->root($root);
 450                 $feed->creator($host);
 451                 $feed->update_ts();
 452                 $feed->link( unapi => $base) if ($flesh_feed);
 453
 454                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 455                 print entityize($feed->toString) . "\n";
 456
 457                 return Apache2::Const::OK;
 458         }
 459
 460         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 461         my $data = $req->gather(1);
 462
 463         if ($req->failed || !$data) {
 464                 print "Content-type: text/html; charset=utf-8\n\n";
 465                 $apache->custom_response( 404, <<"              HTML");
 466                 <html>
 467                         <head>
 468                                 <title>$type $id not found!</title>
 469                         </head>
 470                         <body>
 471                                 <br/>
 472                                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 473                         </body>
 474                 </html>
 475                 HTML
 476                 return 404;
 477         }
 478
 479         print "Content-type: application/xml; charset=utf-8\n\n$data";
 480
 481         return Apache2::Const::OK;
 482 }
 483
 484 sub supercat {
 485
 486         my $apache = shift;
 487         return Apache2::Const::DECLINED if (-e $apache->filename);
 488
 489         my $cgi = new CGI;
 490
 491         my $add_path = 0;
 492         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 493                 my $rel_name = $cgi->url(-relative=>1);
 494                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 495         }
 496
 497         my $url = $cgi->url(-path_info=>$add_path);
 498         my $root = (split 'supercat', $url)[0];
 499         my $base = (split 'supercat', $url)[0] . 'supercat';
 500         my $unapi = (split 'supercat', $url)[0] . 'unapi';
 501
 502         my $host = $cgi->virtual_host || $cgi->server_name;
 503
 504         my $path = $cgi->path_info;
 505         my ($id,$type,$format,$command) = reverse split '/', $path;
 506         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 507         (my $base_format = $format) =~ s/-full$//o;
 508
 509         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 510                 print "Content-type: application/xml; charset=utf-8\n";
 511                 if ($1) {
 512                         my $list = $supercat
 513                                 ->request("open-ils.supercat.$1.formats")
 514                                 ->gather(1);
 515
 516                         print "\n";
 517
 518                         print "<formats>
 519                                    <format>
 520                                      <name>opac</name>
 521                                      <type>text/html</type>
 522                                    </format>";
 523
 524                         if ($1 eq 'record' or $1 eq 'isbn') {
 525                                 print "<format>
 526                                      <name>htmlholdings</name>
 527                                      <type>text/html</type>
 528                                    </format>
 529                                    <format>
 530                                      <name>html</name>
 531                                      <type>text/html</type>
 532                                    </format>
 533                                    <format>
 534                                      <name>htmlholdings-full</name>
 535                                      <type>text/html</type>
 536                                    </format>
 537                                    <format>
 538                                      <name>html-full</name>
 539                                      <type>text/html</type>
 540                                    </format>";
 541                         }
 542
 543                         for my $h (@$list) {
 544                                 my ($type) = keys %$h;
 545                                 print "<format><name>$type</name><type>application/xml</type>";
 546
 547                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 548                                         print "<$part>$$h{$type}{$part}</$part>"
 549                                                 if ($$h{$type}{$part});
 550                                 }
 551
 552                                 print '</format>';
 553
 554                                 if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 555                                         print "<format><name>$type-full</name><type>application/xml</type>";
 556
 557                                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 558                                                 print "<$part>$$h{$type}{$part}</$part>"
 559                                                         if ($$h{$type}{$part});
 560                                         }
 561
 562                                         print '</format>';
 563                                 }
 564
 565                         }
 566
 567                         print "</formats>\n";
 568
 569                         return Apache2::Const::OK;
 570                 }
 571
 572                 my $list = $supercat
 573                         ->request("open-ils.supercat.record.formats")
 574                         ->gather(1);
 575
 576                 push @$list,
 577                         @{ $supercat
 578                                 ->request("open-ils.supercat.metarecord.formats")
 579                                 ->gather(1);
 580                         };
 581
 582                 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 583                 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 584
 585                 print "\n<formats>
 586                            <format>
 587                              <name>opac</name>
 588                              <type>text/html</type>
 589                            </format>
 590                            <format>
 591                              <name>htmlholdings</name>
 592                              <type>text/html</type>
 593                            </format>
 594                            <format>
 595                              <name>html</name>
 596                              <type>text/html</type>
 597                            </format>
 598                            <format>
 599                              <name>htmlholdings-full</name>
 600                              <type>text/html</type>
 601                            </format>
 602                            <format>
 603                              <name>html-full</name>
 604                              <type>text/html</type>
 605                            </format>";
 606
 607                 for my $h (@$list) {
 608                         my ($type) = keys %$h;
 609                         print "<format><name>$type</name><type>application/xml</type>";
 610
 611                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 612                                 print "<$part>$$h{$type}{$part}</$part>"
 613                                         if ($$h{$type}{$part});
 614                         }
 615
 616                         print '</format>';
 617
 618                         if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
 619                                 print "<format><name>$type-full</name><type>application/xml</type>";
 620
 621                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 622                                         print "<$part>$$h{$type}{$part}</$part>"
 623                                                 if ($$h{$type}{$part});
 624                                 }
 625
 626                                 print '</format>';
 627                         }
 628
 629                 }
 630
 631                 print "</formats>\n";
 632
 633
 634                 return Apache2::Const::OK;
 635         }
 636
 637         if ($format eq 'opac') {
 638                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 639                         if ($type eq 'metarecord');
 640                 print "Location: $root/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 641                         if ($type eq 'record');
 642                 return 302;
 643
 644         } elsif ($base_format eq 'marc21') {
 645
 646                 my $ret = 200;
 647                 try {
 648                         my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
 649
 650                         my $r = MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' );
 651                         $r->delete_field( $_ ) for ($r->field(901));
 652
 653                         $r->append_fields(
 654                                 MARC::Field->new(
 655                                         901, '', '',
 656                                         a => $bib->tcn_value,
 657                                         b => $bib->tcn_source,
 658                                         c => $bib->id
 659                                 )
 660                         );
 661
 662                         print "Content-type: application/octet-stream\n\n";
 663                         print $r->as_usmarc;
 664
 665                 } otherwise {
 666                         warn shift();
 667
 668                         print "Content-type: text/html; charset=utf-8\n\n";
 669                         $apache->custom_response( 404, <<"                      HTML");
 670                         <html>
 671                                 <head>
 672                                         <title>ERROR</title>
 673                                 </head>
 674                                 <body>
 675                                         <br/>
 676                                         <center>Couldn't fetch $id as MARC21.</center>
 677                                 </body>
 678                         </html>
 679                         HTML
 680                         $ret = 404;
 681                 };
 682
 683                 return Apache2::Const::OK;
 684
 685         } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
 686                 my $feed = create_record_feed(
 687                         $type,
 688                         $format => [ $id ],
 689                         undef, undef,
 690                         $flesh_feed
 691                 );
 692
 693                 $feed->root($root);
 694                 $feed->creator($host);
 695
 696                 $feed->update_ts();
 697
 698                 $feed->link( unapi => $base) if ($flesh_feed);
 699
 700                 print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 701                 print entityize($feed->toString) . "\n";
 702
 703                 return Apache2::Const::OK;
 704         }
 705
 706         my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
 707         $req->wait_complete;
 708
 709         if ($req->failed) {
 710                 print "Content-type: text/html; charset=utf-8\n\n";
 711                 $apache->custom_response( 404, <<"              HTML");
 712                 <html>
 713                         <head>
 714                                 <title>$type $id not found!</title>
 715                         </head>
 716                         <body>
 717                                 <br/>
 718                                 <center>Sorry, we couldn't $command a $type with the id of $id in format $format.</center>
 719                         </body>
 720                 </html>
 721                 HTML
 722                 return 404;
 723         }
 724
 725         print "Content-type: application/xml; charset=utf-8\n\n";
 726         print entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
 727
 728         return Apache2::Const::OK;
 729 }
 730
 731
 732 sub bookbag_feed {
 733         my $apache = shift;
 734         return Apache2::Const::DECLINED if (-e $apache->filename);
 735
 736         my $cgi = new CGI;
 737
 738         my $year = (gmtime())[5] + 1900;
 739         my $host = $cgi->virtual_host || $cgi->server_name;
 740
 741         my $add_path = 0;
 742         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 743                 my $rel_name = $cgi->url(-relative=>1);
 744                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 745         }
 746
 747         my $url = $cgi->url(-path_info=>$add_path);
 748         my $root = (split 'feed', $url)[0] . '/';
 749         my $base = (split 'bookbag', $url)[0] . '/bookbag';
 750         my $unapi = (split 'feed', $url)[0] . '/unapi';
 751
 752         $root =~ s{(?<!http:)//}{/}go;
 753         $base =~ s{(?<!http:)//}{/}go;
 754         $unapi =~ s{(?<!http:)//}{/}go;
 755
 756         my $path = $cgi->path_info;
 757         #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
 758
 759         my ($id,$type) = reverse split '/', $path;
 760         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 761
 762         my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
 763         return Apache2::Const::NOT_FOUND unless($bucket);
 764
 765         my $bucket_tag = "tag:$host,$year:record_bucket/$id";
 766         if ($type eq 'opac') {
 767                 print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 768                         join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
 769                         "\n\n";
 770                 return 302;
 771         }
 772
 773         my $feed = create_record_feed(
 774                 'record',
 775                 $type,
 776                 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
 777                 $unapi,
 778                 undef,
 779                 $flesh_feed
 780         );
 781         $feed->root($root);
 782         $feed->id($bucket_tag);
 783
 784         $feed->title("Items in Book Bag [".$bucket->name."]");
 785         $feed->creator($host);
 786         $feed->update_ts();
 787
 788         $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
 789         $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
 790         $feed->link(html => $base . "/html-full/$id" => 'text/html');
 791         $feed->link(unapi => $unapi);
 792
 793         $feed->link(
 794                 OPAC =>
 795                 $host . '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 796                         join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
 797                 'text/html'
 798         );
 799
 800
 801         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 802         print entityize($feed->toString) . "\n";
 803
 804         return Apache2::Const::OK;
 805 }
 806
 807 sub changes_feed {
 808         my $apache = shift;
 809         return Apache2::Const::DECLINED if (-e $apache->filename);
 810
 811         my $cgi = new CGI;
 812
 813         my $year = (gmtime())[5] + 1900;
 814         my $host = $cgi->virtual_host || $cgi->server_name;
 815
 816         my $add_path = 0;
 817         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 818                 my $rel_name = $cgi->url(-relative=>1);
 819                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 820         }
 821
 822         my $url = $cgi->url(-path_info=>$add_path);
 823         my $root = (split 'feed', $url)[0];
 824         my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
 825         my $unapi = (split 'feed', $url)[0] . 'unapi';
 826
 827         my $path = $cgi->path_info;
 828         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 829
 830         $path =~ s/^\/(?:feed\/)?freshmeat\///og;
 831
 832         my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
 833         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
 834         $limit ||= 10;
 835
 836         my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
 837
 838         #if ($type eq 'opac') {
 839         #       print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
 840         #               join('&', map { "rl=" . $_ } @$list) .
 841         #               "\n\n";
 842         #       return 302;
 843         #}
 844
 845         my $feed = create_record_feed( 'record', $type, $list, $unapi, undef, $flesh_feed);
 846         $feed->root($root);
 847
 848         if ($date) {
 849                 $feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
 850         } else {
 851                 $feed->title("$limit most recent $rtype ${axis}s");
 852         }
 853
 854         $feed->creator($host);
 855         $feed->update_ts();
 856
 857         $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
 858         $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
 859         $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
 860         $feed->link(unapi => $unapi);
 861
 862         $feed->link(
 863                 OPAC =>
 864                 $host . '/opac/en-US/skin/default/xml/rresult.xml?rt=list&' .
 865                         join('&', map { 'rl=' . $_} @$list ),
 866                 'text/html'
 867         );
 868
 869
 870         print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
 871         print entityize($feed->toString) . "\n";
 872
 873         return Apache2::Const::OK;
 874 }
 875
 876 sub opensearch_osd {
 877         my $version = shift;
 878         my $lib = shift;
 879         my $class = shift;
 880         my $base = shift;
 881
 882         if ($version eq '1.0') {
 883                 print <<OSD;
 884 Content-type: application/opensearchdescription+xml; charset=utf-8
 885
 886 <?xml version="1.0" encoding="UTF-8"?>
 887 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
 888   <Url>$base/1.0/$lib/-/$class/?searchTerms={searchTerms}&amp;startPage={startPage}&amp;startIndex={startIndex}&amp;count={count}</Url>
 889   <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
 890   <ShortName>$lib</ShortName>
 891   <LongName>Search $lib</LongName>
 892   <Description>Search the $lib OPAC by $class.</Description>
 893   <Tags>$lib book library</Tags>
 894   <SampleSearch>harry+potter</SampleSearch>
 895   <Developer>Mike Rylander for GPLS/PINES</Developer>
 896   <Contact>feedback\@open-ils.org</Contact>
 897   <SyndicationRight>open</SyndicationRight>
 898   <AdultContent>false</AdultContent>
 899 </OpenSearchDescription>
 900 OSD
 901         } else {
 902                 print <<OSD;
 903 Content-type: application/opensearchdescription+xml; charset=utf-8
 904
 905 <?xml version="1.0" encoding="UTF-8"?>
 906 <OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
 907   <ShortName>$lib</ShortName>
 908   <Description>Search the $lib OPAC by $class.</Description>
 909   <Tags>$lib book library</Tags>
 910   <Url type="application/rss+xml"
 911        template="$base/1.1/$lib/rss2-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 912   <Url type="application/atom+xml"
 913        template="$base/1.1/$lib/atom-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 914   <Url type="application/x-mods3+xml"
 915        template="$base/1.1/$lib/mods3/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 916   <Url type="application/x-mods+xml"
 917        template="$base/1.1/$lib/mods/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 918   <Url type="application/x-marcxml+xml"
 919        template="$base/1.1/$lib/marcxml/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 920   <Url type="text/html"
 921        template="$base/1.1/$lib/html-full/$class/?searchTerms={searchTerms}&amp;startPage={startPage?}&amp;startIndex={startIndex?}&amp;count={count?}&amp;searchLang={language?}"/>
 922   <LongName>Search $lib</LongName>
 923   <Query role="example" searchTerms="harry+potter" />
 924   <Developer>Mike Rylander for GPLS/PINES</Developer>
 925   <Contact>feedback\@open-ils.org</Contact>
 926   <SyndicationRight>open</SyndicationRight>
 927   <AdultContent>false</AdultContent>
 928   <Language>en-US</Language>
 929   <OutputEncoding>UTF-8</OutputEncoding>
 930   <InputEncoding>UTF-8</InputEncoding>
 931 </OpenSearchDescription>
 932 OSD
 933         }
 934
 935         return Apache2::Const::OK;
 936 }
 937
 938 sub opensearch_feed {
 939         my $apache = shift;
 940         return Apache2::Const::DECLINED if (-e $apache->filename);
 941
 942         my $cgi = new CGI;
 943         my $year = (gmtime())[5] + 1900;
 944
 945         my $host = $cgi->virtual_host || $cgi->server_name;
 946
 947         my $add_path = 0;
 948         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
 949                 my $rel_name = $cgi->url(-relative=>1);
 950                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
 951         }
 952
 953         my $url = $cgi->url(-path_info=>$add_path);
 954         my $root = (split 'opensearch', $url)[0];
 955         my $base = (split 'opensearch', $url)[0] . 'opensearch';
 956         my $unapi = (split 'opensearch', $url)[0] . 'unapi';
 957
 958         my $path = $cgi->path_info;
 959         #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
 960
 961         if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
 962
 963                 my $version = $1;
 964                 my $lib = uc($2);
 965                 my $class = $3;
 966
 967                 if (!$lib || $lib eq '-') {
 968                         $lib = $actor->request(
 969                                 'open-ils.actor.org_unit_list.search' => parent_ou => undef
 970                         )->gather(1)->[0]->shortname;
 971                 }
 972
 973                 if ($class eq '-') {
 974                         $class = 'keyword';
 975                 }
 976
 977                 return opensearch_osd($version, $lib, $class, $base);
 978         }
 979
 980
 981         my $page = $cgi->param('startPage') || 1;
 982         my $offset = $cgi->param('startIndex') || 1;
 983         my $limit = $cgi->param('count') || 10;
 984
 985         $page = 1 if ($page !~ /^\d+$/);
 986         $offset = 1 if ($offset !~ /^\d+$/);
 987         $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
 988
 989         if ($page > 1) {
 990                 $offset = ($page - 1) * $limit;
 991         } else {
 992                 $offset -= 1;
 993         }
 994
 995         my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
 996         (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
 997
 998         $lang = $cgi->param('searchLang') if $cgi->param('searchLang');
 999         $lang = '' if ($lang eq '*');
1000
1001         $sort = $cgi->param('searchSort') if $cgi->param('searchSort');
1002         $sort ||= '';
1003         $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
1004         $sortdir ||= '';
1005
1006         $terms .= " " if ($terms && $cgi->param('searchTerms'));
1007         $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
1008
1009         $class = $cgi->param('searchClass') if $cgi->param('searchClass');
1010         $class ||= '-';
1011
1012         $type = $cgi->param('responseType') if $cgi->param('responseType');
1013         $type ||= '-';
1014
1015         $org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
1016         $org ||= '-';
1017
1018
1019         my $kwt = $cgi->param('kw');
1020         my $tit = $cgi->param('ti');
1021         my $aut = $cgi->param('au');
1022         my $sut = $cgi->param('su');
1023         my $set = $cgi->param('se');
1024
1025         $terms .= " " if ($terms && $kwt);
1026         $terms .= "keyword: $kwt" if ($kwt);
1027         $terms .= " " if ($terms && $tit);
1028         $terms .= "title: $tit" if ($tit);
1029         $terms .= " " if ($terms && $aut);
1030         $terms .= "author: $aut" if ($aut);
1031         $terms .= " " if ($terms && $sut);
1032         $terms .= "subject: $sut" if ($sut);
1033         $terms .= " " if ($terms && $set);
1034         $terms .= "series: $set" if ($set);
1035
1036         if ($version eq '1.0') {
1037                 $type = 'rss2';
1038         } elsif ($type eq '-') {
1039                 $type = 'atom';
1040         }
1041         my $flesh_feed = ($type =~ /-full$/o) ? 1 : 0;
1042
1043         if ($terms eq 'help') {
1044                 print $cgi->header(-type => 'text/html');
1045                 print <<"               HTML";
1046                         <html>
1047                          <head>
1048                           <title>just type something!</title>
1049                          </head>
1050                          <body>
1051                           <p>You are in a maze of dark, twisty stacks, all alike.</p>
1052                          </body>
1053                         </html>
1054                 HTML
1055                 return Apache2::Const::OK;
1056     }
1057
1058         $terms = decode_utf8($terms);
1059         $lang = 'eng' if ($lang eq 'en-US');
1060
1061         $log->debug("OpenSearch terms: $terms");
1062
1063         my $org_unit;
1064         if ($org eq '-') {
1065                 $org_unit = $actor->request(
1066                         'open-ils.actor.org_unit_list.search' => parent_ou => undef
1067                 )->gather(1);
1068         } elsif ($org !~ /^\d+$/o) {
1069                 $org_unit = $actor->request(
1070                         'open-ils.actor.org_unit_list.search' => shortname => uc($org)
1071                 )->gather(1);
1072         } else {
1073                 $org_unit = $actor->request(
1074                         'open-ils.actor.org_unit_list.search' => id => $org
1075                 )->gather(1);
1076         }
1077
1078     my $recs = $search->request(
1079         'open-ils.search.biblio.multiclass.query' => {
1080                         org_unit        => $org_unit->[0]->id,
1081                         offset          => $offset,
1082                         limit           => $limit,
1083                         sort            => $sort,
1084                         sort_dir        => $sortdir,
1085                         ($lang ?    ( 'language' => $lang    ) : ()),
1086                 } => $terms => 1
1087         )->gather(1);
1088
1089         $log->debug("Hits for [$terms]: $recs->{count}");
1090
1091         my $feed = create_record_feed(
1092                 'record',
1093                 $type,
1094                 [ map { $_->[0] } @{$recs->{ids}} ],
1095                 $unapi,
1096                 $org,
1097                 $flesh_feed
1098         );
1099
1100         $log->debug("Feed created...");
1101
1102         $feed->root($root);
1103         $feed->lib($org);
1104         $feed->search($terms);
1105         $feed->class($class);
1106
1107         $feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
1108
1109         $feed->creator($host);
1110         $feed->update_ts();
1111
1112         $feed->_create_node(
1113                 $feed->{item_xpath},
1114                 'http://a9.com/-/spec/opensearch/1.1/',
1115                 'totalResults',
1116                 $recs->{count},
1117         );
1118
1119         $feed->_create_node(
1120                 $feed->{item_xpath},
1121                 'http://a9.com/-/spec/opensearch/1.1/',
1122                 'startIndex',
1123                 $offset + 1,
1124         );
1125
1126         $feed->_create_node(
1127                 $feed->{item_xpath},
1128                 'http://a9.com/-/spec/opensearch/1.1/',
1129                 'itemsPerPage',
1130                 $limit,
1131         );
1132
1133         $log->debug("...basic feed data added...");
1134
1135         $feed->link(
1136                 next =>
1137                 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
1138                 'application/opensearch+xml'
1139         ) if ($offset + $limit < $recs->{count});
1140
1141         $feed->link(
1142                 previous =>
1143                 $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
1144                 'application/opensearch+xml'
1145         ) if ($offset);
1146
1147         $feed->link(
1148                 self =>
1149                 $base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1150                 'application/opensearch+xml'
1151         );
1152
1153         $feed->link(
1154                 alternate =>
1155                 $base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1156                 'application/rss+xml'
1157         );
1158
1159         $feed->link(
1160                 atom =>
1161                 $base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1162                 'application/atom+xml'
1163         );
1164
1165         $feed->link(
1166                 'html' =>
1167                 $base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1168                 'text/html'
1169         );
1170
1171         $feed->link(
1172                 'html-full' =>
1173                 $base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
1174                 'text/html'
1175         );
1176
1177         $feed->link( 'unapi-server' => $unapi);
1178
1179         $log->debug("...feed links added...");
1180
1181 #       $feed->link(
1182 #               opac =>
1183 #               $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
1184 #                       join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
1185 #               'text/html'
1186 #       );
1187
1188         #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
1189         print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
1190
1191         $log->debug("...and feed returned.");
1192
1193         return Apache2::Const::OK;
1194 }
1195
1196 sub create_record_feed {
1197         my $search = shift;
1198         my $type = shift;
1199         my $records = shift;
1200         my $unapi = shift;
1201
1202         my $lib = uc(shift()) || '-';
1203         my $flesh = shift;
1204         $flesh = 1 if (!defined($flesh));
1205
1206         my $cgi = new CGI;
1207         my $base = $cgi->url;
1208         my $host = $cgi->virtual_host || $cgi->server_name;
1209
1210         my $year = (gmtime())[5] + 1900;
1211
1212         my $flesh_feed = ($type =~ s/-full$//o) ? 1 : 0;
1213
1214         my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
1215         $feed->base($base) if ($flesh);
1216         $feed->unapi($unapi) if ($flesh);
1217
1218         $type = 'atom' if ($type eq 'html');
1219         $type = 'marcxml' if ($type eq 'htmlholdings');
1220
1221         #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
1222
1223         my $count = 0;
1224         for my $record (@$records) {
1225                 next unless($record);
1226
1227                 #my $rec = $record->id;
1228                 my $rec = $record;
1229
1230                 my $item_tag = "tag:$host,$year:biblio-record_entry/$rec/$lib";
1231                 $item_tag = "tag:$host,$year:isbn/$rec/$lib" if ($search eq 'isbn');
1232
1233                 my $xml = $supercat->request(
1234                         "open-ils.supercat.$search.$type.retrieve",
1235                         $rec
1236                 )->gather(1);
1237                 next unless $xml;
1238
1239                 my $node = $feed->add_item($xml);
1240                 next unless $node;
1241
1242                 $xml = '';
1243                 if ($lib && $type eq 'marcxml' &&  $flesh) {
1244                         my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib );
1245                         while ( !$r->complete ) {
1246                                 $xml .= join('', map {$_->content} $r->recv);
1247                         }
1248                         $xml .= join('', map {$_->content} $r->recv);
1249                         $node->add_holdings($xml);
1250                 }
1251
1252                 $node->id($item_tag);
1253                 #$node->update_ts(clense_ISO8601($record->edit_date));
1254                 $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh);
1255                 $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh);
1256                 $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
1257                 $node->link('unapi-id' => $item_tag) if ($flesh);
1258         }
1259
1260         return $feed;
1261 }
1262
1263 sub entityize {
1264         my $stuff = NFC(shift());
1265         $stuff =~ s/&(?!\S+;)/&amp;/gso;
1266         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
1267         return $stuff;
1268 }
1269
1270 sub string_browse {
1271         my $apache = shift;
1272         return Apache2::Const::DECLINED if (-e $apache->filename);
1273
1274         my $cgi = new CGI;
1275         my $year = (gmtime())[5] + 1900;
1276
1277         my $host = $cgi->virtual_host || $cgi->server_name;
1278
1279         my $add_path = 0;
1280         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1281                 my $rel_name = $cgi->url(-relative=>1);
1282                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1283         }
1284
1285         my $url = $cgi->url(-path_info=>$add_path);
1286         my $root = (split 'browse', $url)[0];
1287         my $base = (split 'browse', $url)[0] . 'browse';
1288         my $unapi = (split 'browse', $url)[0] . 'unapi';
1289
1290         my $path = $cgi->path_info;
1291         $path =~ s/^\///og;
1292
1293         my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
1294         #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1295
1296         $site ||= $cgi->param('searchOrg');
1297         $page ||= $cgi->param('startPage') || 0;
1298         $page_size ||= $cgi->param('count') || 9;
1299
1300         $page = 0 if ($page !~ /^-?\d+$/);
1301
1302         my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
1303         my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
1304
1305         unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
1306                 warn "something's wrong...";
1307                 warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
1308                 return undef;
1309         }
1310
1311         $string = decode_utf8($string);
1312         $string =~ s/\+/ /go;
1313         $string =~ s/'//go;
1314
1315         my $tree = $supercat->request(
1316                 "open-ils.supercat.$axis.browse",
1317                 $string,
1318                 $site,
1319                 $page_size,
1320                 $page
1321         )->gather(1);
1322
1323     (my $norm_format = $format) =~ s/-full$//o;
1324
1325         my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
1326         print $header.$content;
1327         return Apache2::Const::OK;
1328 }
1329
1330 our %qualifier_map = (
1331
1332     # Some EG qualifiers
1333     'eg.site'               => 'site',
1334     'eg.sort'               => 'sort',
1335     'eg.direction'          => 'dir',
1336     'eg.available'          => 'available',
1337
1338     # Title class:
1339     'eg.title'              => 'title',
1340     'dc.title'              => 'title',
1341     'bib.titleabbreviated'  => 'title|abbreviated',
1342     'bib.titleuniform'      => 'title|uniform',
1343     'bib.titletranslated'   => 'title|translated',
1344     'bib.titlealternative'  => 'title',
1345     'bib.titleseries'       => 'series',
1346     'eg.series'             => 'title',
1347
1348     # Author/Name class:
1349     'eg.author'             => 'author',
1350     'eg.name'               => 'author',
1351     'creator'               => 'author',
1352     'dc.creator'            => 'author',
1353     'dc.contributer'        => 'author',
1354     'dc.publisher'          => 'keyword',
1355     'bib.name'              => 'author',
1356     'bib.namepersonal'      => 'author|personal',
1357     'bib.namepersonalfamily'=> 'author|personal',
1358     'bib.namepersonalgiven' => 'author|personal',
1359     'bib.namecorporate'     => 'author|corporate',
1360     'bib.nameconference'    => 'author|conference',
1361
1362     # Subject class:
1363     'eg.subject'            => 'subject',
1364     'dc.subject'            => 'subject',
1365     'bib.subjectplace'      => 'subject|geographic',
1366     'bib.subjecttitle'      => 'keyword',
1367     'bib.subjectname'       => 'subject|name',
1368     'bib.subjectoccupation' => 'keyword',
1369
1370     # Keyword class:
1371     'eg.keyword'            => 'keyword',
1372     'srw.serverchoice'      => 'keyword',
1373
1374     # Identifiers:
1375     'dc.identifier'         => 'keyword',
1376
1377     # Dates:
1378     'bib.dateissued'        => undef,
1379     'bib.datecreated'       => undef,
1380     'bib.datevalid'         => undef,
1381     'bib.datemodified'      => undef,
1382     'bib.datecopyright'     => undef,
1383
1384     # Resource Type:
1385     'dc.type'               => undef,
1386
1387     # Format:
1388     'dc.format'             => undef,
1389
1390     # Genre:
1391     'bib.genre'             => 'keyword',
1392
1393     # Target Audience:
1394     'bib.audience'          => undef,
1395
1396     # Place of Origin:
1397     'bib.originplace'       => undef,
1398
1399     # Language
1400     'dc.language'           => 'lang',
1401
1402     # Edition
1403     'bib.edition'           => 'keyword',
1404
1405     # Part:
1406     'bib.volume'            => 'keyword',
1407     'bib.issue'             => 'keyword',
1408     'bib.startpage'         => 'keyword',
1409     'bib.endpage'           => 'keyword',
1410
1411     # Issuance:
1412     'bib.issuance'          => 'keyword',
1413 );
1414
1415 our %qualifier_ids = (
1416                 eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
1417                 dc => 'info:srw/cql-context-set/1/dc-v1.1',
1418                 bib => 'info:srw/cql-context-set/1/bib-v1.0',
1419                 srw     => ''
1420 );
1421
1422 our %nested_qualifier_map = (
1423                 eg => {
1424                         site            => ['site','Evergreen Site Code (shortname)'],
1425                         sort            => ['sort','Sort on relevance, title, author, pubdate, create_date or edit_date'],
1426                         direction       => ['dir','Sort direction (asc|desc)'],
1427                         available       => ['available','Filter to available (true|false)'],
1428                         title           => ['title'],
1429                         author          => ['author'],
1430                         name            => ['author'],
1431                         subject         => ['subject'],
1432                         keyword         => ['keyword'],
1433                         series          => ['series'],
1434                 },
1435                 dc => {
1436                         title           => ['title'],
1437                         creator         => ['author'],
1438                         contributor     => ['author'],
1439                         publisher       => ['keyword'],
1440                         subject         => ['subject'],
1441                         identifier      => ['keyword'],
1442                         type            => [undef],
1443                         format          => [undef],
1444                         language        => ['lang'],
1445                 },
1446                 bib => {
1447                 # Title class:
1448                 titleAbbreviated        => ['title'],
1449                     titleUniform                => ['title'],
1450                         titleTranslated         => ['title'],
1451                 titleAlternative        => ['title'],
1452                     titleSeries                 => ['series'],
1453
1454     # Author/Name class:
1455                         name                            => ['author'],
1456                         namePersonal            => ['author'],
1457                         namePersonalFamily      => ['author'],
1458                         namePersonalGiven       => ['author'],
1459                         nameCorporate           => ['author'],
1460                         nameConference          => ['author'],
1461
1462                 # Subject class:
1463                         subjectPlace            => ['subject'],
1464                         subjectTitle            => ['keyword'],
1465                         subjectName                     => ['subject|name'],
1466                         subjectOccupation       => ['keyword'],
1467
1468     # Keyword class:
1469
1470     # Dates:
1471                         dateIssued                      => [undef],
1472                         dateCreated                     => [undef],
1473                         dateValid                       => [undef],
1474                         dateModified            => [undef],
1475                         dateCopyright           => [undef],
1476
1477     # Genre:
1478                         genre                           => ['keyword'],
1479
1480     # Target Audience:
1481                         audience                        => [undef],
1482
1483     # Place of Origin:
1484                         originPlace                     => [undef],
1485
1486     # Edition
1487                         edition                         => ['keyword'],
1488
1489     # Part:
1490                         volume                          => ['keyword'],
1491                         issue                           => ['keyword'],
1492                         startPage                       => ['keyword'],
1493                         endPage                         => ['keyword'],
1494
1495     # Issuance:
1496                         issuance                        => ['keyword'],
1497                 },
1498                 srw     => {
1499                         serverChoice            => ['keyword'],
1500                 },
1501 );
1502
1503
1504 my $base_explain = <<XML;
1505 <explain
1506                 id="evergreen-sru-explain-full"
1507                 authoritative="true"
1508                 xmlns:z="http://explain.z3950.org/dtd/2.0/"
1509                 xmlns="http://explain.z3950.org/dtd/2.0/">
1510         <serverInfo transport="http" protocol="SRU" version="1.1">
1511                 <host/>
1512                 <port/>
1513                 <database/>
1514         </serverInfo>
1515
1516         <databaseInfo>
1517                 <title primary="true"/>
1518                 <description primary="true"/>
1519         </databaseInfo>
1520
1521         <indexInfo>
1522                 <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
1523         </indexInfo>
1524
1525         <schemaInfo>
1526                 <schema
1527                                 identifier="info:srw/schema/1/marcxml-v1.1"
1528                                 location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1529                                 sort="true"
1530                                 retrieve="true"
1531                                 name="marcxml">
1532                         <title>MARC21Slim (marcxml)</title>
1533                 </schema>
1534         </schemaInfo>
1535
1536         <configInfo>
1537                 <default type="numberOfRecords">10</default>
1538                 <default type="contextSet">eg</default>
1539                 <default type="index">keyword</default>
1540                 <default type="relation">all</default>
1541                 <default type="sortSchema">marcxml</default>
1542                 <default type="retrieveSchema">marcxml</default>
1543                 <setting type="maximumRecords">10</setting>
1544                 <supports type="relationModifier">relevant</supports>
1545                 <supports type="relationModifier">stem</supports>
1546                 <supports type="relationModifier">fuzzy</supports>
1547                 <supports type="relationModifier">word</supports>
1548         </configInfo>
1549
1550 </explain>
1551 XML
1552
1553
1554 my $ex_doc;
1555 sub sru_search {
1556     my $cgi = new CGI;
1557
1558     my $req = SRU::Request->newFromCGI( $cgi );
1559     my $resp = SRU::Response->newFromRequest( $req );
1560
1561     if ( $resp->type eq 'searchRetrieve' ) {
1562                 my $cql_query = $req->query;
1563                 my $search_string = $req->cql->toEvergreen;
1564
1565         my $offset = $req->startRecord;
1566         $offset-- if ($offset);
1567         $offset ||= 0;
1568
1569         my $limit = $req->maximumRecords;
1570         $limit ||= 10;
1571
1572         $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
1573
1574                 my $recs = $search->request(
1575                         'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
1576                 )->gather(1);
1577
1578         my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
1579
1580         $resp->addRecord(
1581             SRU::Response::Record->new(
1582                 recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
1583                 recordData => $_->marc
1584             )
1585         ) for @$bre;
1586
1587         $resp->numberOfRecords($recs->{count});
1588
1589     } elsif ( $resp->type eq 'explain' ) {
1590                 if (!$ex_doc) {
1591                         my $host = $cgi->virtual_host || $cgi->server_name;
1592
1593                         my $add_path = 0;
1594                         if ( $cgi->server_software !~ m|^Apache/2.2| ) {
1595                                 my $rel_name = $cgi->url(-relative=>1);
1596                                 $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
1597                         }
1598                         my $base = $cgi->url(-base=>1);
1599                         my $url = $cgi->url(-path_info=>$add_path);
1600                         $url =~ s/^$base\///o;
1601
1602                         my $doc = $parser->parse_string($base_explain);
1603                         my $e = $doc->documentElement;
1604                         $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
1605                         $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
1606                         $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
1607
1608                         for my $name ( keys %OpenILS::WWW::SuperCat::nested_qualifier_map ) {
1609
1610                                 my $identifier = $OpenILS::WWW::SuperCat::qualifier_ids{ $name };
1611
1612                                 next unless $identifier;
1613
1614                                 my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
1615                                 $set_node->setAttribute( identifier => $identifier );
1616                                 $set_node->setAttribute( name => $name );
1617
1618                                 $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
1619
1620                                 for my $index ( keys %{ $OpenILS::WWW::SuperCat::nested_qualifier_map{$name} } ) {
1621                                         my $desc = $OpenILS::WWW::SuperCat::nested_qualifier_map{$name}{$index}[1] || $index;
1622
1623                                         my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
1624
1625                                         my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
1626                                         $map_node->appendChild( $name_node );
1627
1628                                         my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
1629
1630                                         my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
1631                                         $index_node->appendChild( $title_node );
1632                                         $index_node->appendChild( $map_node );
1633
1634                                         $index_node->setAttribute( id => $name . '.' . $index );
1635                                         $title_node->appendText( $desc );
1636                                         $name_node->setAttribute( set => $name );
1637                                         $name_node->appendText($index );
1638
1639                                         $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
1640                                 }
1641                         }
1642
1643                         $ex_doc = $e->toString;
1644                 }
1645
1646                 $resp->record(
1647                         SRU::Response::Record->new(
1648                                 recordSchema    => 'info:srw/cql-context-set/2/zeerex-1.1',
1649                                 recordData              => $ex_doc
1650                         )
1651                 );
1652         }
1653
1654         print $cgi->header( -type => 'application/xml' );
1655         print entityize($resp->asXML) . "\n";
1656     return Apache2::Const::OK;
1657 }
1658
1659
1660 {
1661     package CQL::BooleanNode;
1662
1663     sub toEvergreen {
1664         my $self     = shift;
1665         my $left     = $self->left();
1666         my $right    = $self->right();
1667         my $leftStr  = $left->toEvergreen;
1668         my $rightStr = $right->toEvergreen();
1669
1670         my $op =  '||' if uc $self->op() eq 'OR';
1671         $op ||=  '&&';
1672
1673         return  "$leftStr $rightStr";
1674     }
1675
1676     package CQL::TermNode;
1677
1678     sub toEvergreen {
1679         my $self      = shift;
1680         my $qualifier = $self->getQualifier();
1681         my $term      = $self->getTerm();
1682         my $relation  = $self->getRelation();
1683
1684         my $query;
1685         if ( $qualifier ) {
1686                         my ($qset, $qname) = split(/\./, $qualifier);
1687
1688                         $log->debug("SRU toEvergreen: $qset, $qname   $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0]\n");
1689
1690             if ( exists($OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}) ) {
1691                 $qualifier = $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0] || 'kw';
1692                         }
1693
1694             my @modifiers = $relation->getModifiers();
1695
1696             my $base = $relation->getBase();
1697             if ( grep { $base eq $_ } qw/= scr exact all/ ) {
1698
1699                 my $quote_it = 1;
1700                 foreach my $m ( @modifiers ) {
1701                     if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
1702                         $quote_it = 0;
1703                         last;
1704                     }
1705                 }
1706
1707                 $quote_it = 0 if ( $base eq 'all' );
1708                 $term = maybeQuote($term) if $quote_it;
1709
1710             } else {
1711                 croak( "Evergreen doesn't support the $base relations" );
1712             }
1713
1714
1715         } else {
1716             $qualifier = "kw";
1717         }
1718
1719         return "$qualifier:$term";
1720     }
1721 }
1722
1723 1;