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