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>\n";
  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         my $host = $cgi->virtual_host || $cgi->server_name;
  79
  80         my $format = $cgi->param('format');
  81         my ($id,$type,$command) = ('','','');
  82
  83         if (!$format) {
  84                 if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
  85                         $id = $2;
  86                         $type = 'record';
  87                         $type = 'metarecord' if ($1 =~ /^m/o);
  88
  89                         my $list = $supercat
  90                         ->request("open-ils.supercat.$type.formats")
  91                                 ->gather(1);
  92
  93                         print "\n";
  94
  95                         my $body =
  96                                 "<formats>
  97                                  <uri>$uri</uri>
  98                                    <format>
  99                                      <name>opac</name>
 100                                      <type>text/html</type>
 101                                    </format>";
 102
 103                         for my $h (@$list) {
 104                                 my ($type) = keys %$h;
 105                                 $body .= "<format><name>$type</name><type>application/$type+xml</type>";
 106
 107                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 108                                         $body .= "<$part>$$h{$type}{$part}</$part>"
 109                                                 if ($$h{$type}{$part});
 110                                 }
 111
 112                                 $body .= '</format>';
 113                         }
 114
 115                         $body .= "</formats>\n";
 116
 117                         $apache->custom_response( 300, $body);
 118                         return 300;
 119                 } else {
 120                         my $list = $supercat
 121                                 ->request("open-ils.supercat.record.formats")
 122                                 ->gather(1);
 123
 124                         push @$list,
 125                                 @{ $supercat
 126                                         ->request("open-ils.supercat.metarecord.formats")
 127                                         ->gather(1);
 128                                 };
 129
 130                         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 131                         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 132
 133                         print "\n<formats>
 134                                    <format>
 135                                      <name>opac</name>
 136                                      <type>text/html</type>
 137                                    </format>";
 138
 139                         for my $h (@$list) {
 140                                 my ($type) = keys %$h;
 141                                 print "<format><name>$type</name><type>application/$type+xml</type>";
 142
 143                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 144                                         print "<$part>$$h{$type}{$part}</$part>"
 145                                                 if ($$h{$type}{$part});
 146                                 }
 147
 148                                 print '</format>';
 149                         }
 150
 151                         print "</formats>\n";
 152
 153
 154                         return Apache2::Const::OK;
 155                 }
 156         }
 157
 158
 159         if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
 160                 $id = $2;
 161                 $type = 'record';
 162                 $type = 'metarecord' if ($1 =~ /^m/o);
 163                 $command = 'retrieve';
 164         }
 165
 166         if ($format eq 'opac') {
 167                 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 168                         if ($type eq 'metarecord');
 169                 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 170                         if ($type eq 'record');
 171                 return 302;
 172         }
 173
 174         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
 175
 176         return Apache2::Const::OK;
 177 }
 178
 179 sub supercat {
 180
 181         my $apache = shift;
 182         return Apache2::Const::DECLINED if (-e $apache->filename);
 183
 184         my $path = $apache->path_info;
 185
 186         my $cgi = new CGI;
 187         my $base = $cgi->url;
 188
 189         my ($id,$type,$format,$command) = reverse split '/', $path;
 190
 191         print "Content-type: application/xml; charset=utf-8\n";
 192
 193         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
 194                 if ($1) {
 195                         my $list = $supercat
 196                                 ->request("open-ils.supercat.$1.formats")
 197                                 ->gather(1);
 198
 199                         print "\n";
 200
 201                         print "<formats>
 202                                    <format>
 203                                      <name>opac</name>
 204                                      <type>text/html</type>
 205                                    </format>";
 206
 207                         for my $h (@$list) {
 208                                 my ($type) = keys %$h;
 209                                 print "<format><name>$type</name><type>application/$type+xml</type>";
 210
 211                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
 212                                         print "<$part>$$h{$type}{$part}</$part>"
 213                                                 if ($$h{$type}{$part});
 214                                 }
 215
 216                                 print '</format>';
 217                         }
 218
 219                         print "</formats>\n";
 220
 221                         return Apache2::Const::OK;
 222                 }
 223
 224                 my $list = $supercat
 225                         ->request("open-ils.supercat.record.formats")
 226                         ->gather(1);
 227
 228                 push @$list,
 229                         @{ $supercat
 230                                 ->request("open-ils.supercat.metarecord.formats")
 231                                 ->gather(1);
 232                         };
 233
 234                 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
 235                 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
 236
 237                 print "\n<formats>
 238                            <format>
 239                              <name>opac</name>
 240                              <type>text/html</type>
 241                            </format>";
 242
 243                 for my $h (@$list) {
 244                         my ($type) = keys %$h;
 245                         print "<format><name>$type</name><type>application/$type+xml</type>";
 246
 247                         for my $part ( qw/namespace_uri docs schema_location/ ) {
 248                                 print "<$part>$$h{$type}{$part}</$part>"
 249                                         if ($$h{$type}{$part});
 250                         }
 251
 252                         print '</format>';
 253                 }
 254
 255                 print "</formats>\n";
 256
 257
 258                 return Apache2::Const::OK;
 259         }
 260
 261         if ($format eq 'opac') {
 262                 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 263                         if ($type eq 'metarecord');
 264                 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 265                         if ($type eq 'record');
 266                 return 302;
 267         }
 268
 269         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
 270
 271         return Apache2::Const::OK;
 272 }
 273
 274 1;