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 handler {
  37
  38         my $apache = shift;
  39         return Apache2::Const::DECLINED if (-e $apache->filename);
  40
  41         my $path = $apache->path_info;
  42
  43         my ($id,$type,$format,$command) = reverse split '/', $path;
  44
  45         print "Content-type: application/xml; charset=utf-8\n";
  46
  47         if ( $path =~ m{^/?$}o ) {
  48                 my $cgi = new CGI;
  49
  50                 my $uri = $cgi->param('uri') || '';
  51                 my $base = $cgi->url;
  52
  53                 $format = $cgi->param('format');
  54                 ($id,$type) = ('','');
  55
  56                 if (!$format) {
  57                         if ($uri =~ m{^info:oils/([^\/]+)/(\d+)}o) {
  58                                 $id = $2;
  59                                 $type = 'record';
  60                                 $type = 'metarecord' if ($1 =~ /^m/o);
  61
  62                                 my $list = $supercat
  63                                         ->request("open-ils.supercat.$type.formats")
  64                                         ->gather(1);
  65
  66                                 print "\n";
  67
  68                                 my $body =
  69                                         "<formats>
  70                                          <uri>$uri</uri>
  71                                            <format>
  72                                              <name>opac</name>
  73                                              <type>text/html</type>
  74                                            </format>".
  75
  76                                         join('',
  77                                                 map { "  <format>
  78                                                            <name>$_</name>
  79                                                            <type>application/xml</type>
  80                                                          </format>"
  81                                                 } @$list
  82                                         ).
  83
  84                                         '</formats>';
  85
  86                                 $apache->custom_response( 300, $body);
  87                                 return 300;
  88                         } else {
  89                                 my $list = $supercat
  90                                         ->request("open-ils.supercat.record.formats")
  91                                         ->gather(1);
  92                                 push @$list,
  93                                         @{ $supercat
  94                                                 ->request("open-ils.supercat.metarecord.formats")
  95                                                 ->gather(1);
  96                                         };
  97
  98                                 my %hash = map { ($_ => $_) } @$list;
  99                                 $list = [ sort keys %hash ];
 100
 101                                 print "\n<formats>
 102                                            <format>
 103                                              <name>opac</name>
 104                                              <type>text/html</type>
 105                                            </format>".
 106                                         join('',
 107                                                 map {
 108                                                         "<format><name>$_</name><type>text/xml</type></format>"
 109                                                 } @$list
 110                                         ).'</formats>';
 111                                 return Apache2::Const::OK;
 112                         }
 113                 }
 114
 115
 116                 if ($uri =~ m{^info:oils/([^\/]+)/(\d+)}o) {
 117                         $id = $2;
 118                         $type = 'record';
 119                         $type = 'metarecord' if ($1 =~ /^m/o);
 120                         $command = 'retrieve';
 121                 }
 122
 123                 if ($format eq 'opac') {
 124                         print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
 125                                 if ($type eq 'metarecord');
 126                         print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
 127                                 if ($type eq 'record');
 128                         return 302;
 129                 }
 130
 131         } elsif ( $path =~ m{^/formats/([^\/]+)$}o ) {
 132                 my $list = $supercat
 133                         ->request("open-ils.supercat.$1.formats")
 134                         ->gather(1);
 135
 136                 print "\n<formats>".
 137                         join('',
 138                                 map {
 139                                         "<format><name>$_</name><type>text/xml</type></format>"
 140                                 } @$list
 141                         ).'</formats>';
 142                 return Apache2::Const::OK;
 143         }
 144
 145         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
 146
 147         return Apache2::Const::OK;
 148 }
 149
 150 1;