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

   1 package OpenILS::WWW::SuperCat;
   2 use strict; use warnings;
   3
   4 use Apache2 ();
   5 use Apache2::Log;
   6 use Apache2::Const -compile => qw(OK REDIRECT DECLINED :log);
   7 use APR::Const    -compile => qw(:error SUCCESS);
   8 use Apache2::RequestRec ();
   9 use Apache2::RequestIO ();
  10 use Apache2::RequestUtil;
  11 use CGI;
  12 use Data::Dumper;
  13
  14 use OpenSRF::EX qw(:try);
  15 use OpenSRF::System;
  16 use OpenSRF::AppSession;
  17 use XML::LibXML;
  18
  19 use OpenILS::Utils::Fieldmapper;
  20
  21
  22 # set the bootstrap config when this module is loaded
  23 my ($bootstrap, $supercat);
  24
  25 sub import {
  26         my $self = shift;
  27         $bootstrap = shift;
  28 }
  29
  30
  31 sub child_init {
  32         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  33         $supercat = OpenSRF::AppSession->create('open-ils.supercat');
  34 }
  35
  36 sub oisbn {
  37
  38         my $apache = shift;
  39         return Apache2::Const::DECLINED if (-e $apache->filename);
  40
  41         (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
  42
  43         my $list = $supercat
  44                 ->request("open-ils.supercat.oisbn", $isbn)
  45                 ->gather(1);
  46
  47         print "Content-type: application/xml; charset=utf-8\n\n";
  48         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
  49
  50         unless (exists $$list{metarecord}) {
  51                 print '<idlist/>';
  52                 return Apache2::Const::OK;
  53         }
  54
  55         print "<idlist metarecord='$$list{metarecord}'>\n";
  56
  57         for ( keys %{ $$list{record_list} } ) {
  58                 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
  59                 print "  <isbn record='$_'>$o</isbn>\n"
  60         }
  61
  62         print "</idlist>";
  63
  64         return Apache2::Const::OK;
  65 }
  66
  67 sub unapi {
  68
  69         my $apache = shift;
  70         return Apache2::Const::DECLINED if (-e $apache->filename);
  71
  72         print "Content-type: application/xml; charset=utf-8\n";
  73
  74         my $cgi = new CGI;
  75
  76         my $uri = $cgi->param('uri') || '';
  77         my $base = $cgi->url;
  78
  79         my $format = $cgi->param('format');
  80         my ($id,$type,$command) = ('','','');
  81
  82         if (!$format) {
  83                 if ($uri =~ m{^info:oils/([^\/]+)/(\d+)}o) {
  84                         $id = $2;
  85                         $type = 'record';
  86                         $type = 'metarecord' if ($1 =~ /^m/o);
  87
  88                         my $list = $supercat
  89                         ->request("open-ils.supercat.$type.formats")
  90                                 ->gather(1);
  91
  92                         print "\n";
  93
  94                         my $body =
  95                                 "<formats>
  96                                  <uri>$uri</uri>
  97                                    <format>
  98                                      <name>opac</name>
  99                                      <type>text/html</type>
 100                                    </format>".
 101
 102                                 join('',
 103                                         map { "  <format>
 104                                                    <name>$_</name>
 105                                                    <type>application/xml</type>
 106                                          </format>"
 107                                         } @$list
 108                                 ).
 109
 110                                 '</formats>';
 111
 112                 $apache->custom_response( 300, $body);
 113                         return 300;
 114                 } else {
 115                         my $list = $supercat
 116                                 ->request("open-ils.supercat.record.formats")
 117                                 ->gather(1);
 118
 119                         push @$list,
 120                                 @{ $supercat
 121                                         ->request("open-ils.supercat.metarecord.formats")
 122                                         ->gather(1);
 123                                 };
 124
 125                         my %hash = map { ($_ => $_) } @$list;
 126                         $list = [ sort keys %hash ];
 127
 128                         print "\n<formats>
 129                                    <format>
 130                                      <name>opac</name>
 131                                      <type>text/html</type>
 132                                    </format>".
 133                                 join('',
 134                                         map {
 135                                                 "<format><name>$_</name><type>text/xml</type></format>"
 136                                         } @$list
 137                                 ).'</formats>';
 138                         return Apache2::Const::OK;
 139                 }
 140         }
 141
 142
 143         if ($uri =~ m{^info:oils/([^\/]+)/(\d+)}o) {
 144                 $id = $2;
 145                 $type = 'record';
 146                 $type = 'metarecord' if ($1 =~ /^m/o);
 147                 $command = 'retrieve';
 148         }
 149
 150         if ($format eq 'opac') {
 151                 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 152                         if ($type eq 'metarecord');
 153                 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 154                         if ($type eq 'record');
 155                 return 302;
 156         }
 157
 158         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
 159
 160         return Apache2::Const::OK;
 161 }
 162
 163 sub supercat {
 164
 165         my $apache = shift;
 166         return Apache2::Const::DECLINED if (-e $apache->filename);
 167
 168         my $path = $apache->path_info;
 169
 170         my ($id,$type,$format,$command) = reverse split '/', $path;
 171
 172         print "Content-type: application/xml; charset=utf-8\n";
 173
 174         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 175                 if ($1) {
 176                         my $list = $supercat
 177                                 ->request("open-ils.supercat.$1.formats")
 178                                 ->gather(1);
 179
 180                         print "\n<formats>
 181                                    <name>opac</name>
 182                                    <type>text/html</type>".
 183                                 join('',
 184                                         map {
 185                                                 "<format><name>$_</name><type>text/xml</type></format>"
 186                                         } @$list
 187                                 ).'</formats>';
 188
 189                         return Apache2::Const::OK;
 190                 }
 191
 192                 my $list = $supercat
 193                         ->request("open-ils.supercat.record.formats")
 194                         ->gather(1);
 195
 196                 push @$list,
 197                         @{ $supercat
 198                                 ->request("open-ils.supercat.metarecord.formats")
 199                                 ->gather(1);
 200                         };
 201
 202                 my %hash = map { ($_ => $_) } @$list;
 203                 $list = [ sort keys %hash ];
 204
 205                 print "\n<formats>
 206                            <format>
 207                              <name>opac</name>
 208                              <type>text/html</type>
 209                            </format>".
 210                         join('',
 211                                 map {
 212                                         "<format><name>$_</name><type>text/xml</type></format>"
 213                                 } @$list
 214                         ).'</formats>';
 215                 return Apache2::Const::OK;
 216         }
 217
 218         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
 219
 220         return Apache2::Const::OK;
 221 }
 222
 223 1;