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

   1 package OpenILS::WWW::Method;
   2 use strict; use warnings;
   3
   4 use Apache2 ();
   5 use Apache2::Log;
   6 use Apache2::Const -compile => qw(OK REDIRECT :log);
   7 use APR::Const    -compile => qw(:error SUCCESS);
   8 use Apache2::RequestRec ();
   9 use Apache2::RequestIO ();
  10 use Apache2::RequestUtil;
  11
  12 use JSON;
  13
  14 use CGI ();
  15
  16 use OpenSRF::EX qw(:try);
  17 use OpenSRF::System;
  18
  19 my %session_hash;
  20
  21 use constant MAX_SESSION_REQUESTS => 20;
  22
  23 sub handler {
  24
  25         use Data::Dumper;
  26
  27
  28         my $apache = shift;
  29         my $cgi = CGI->new( $apache );
  30
  31         print "Content-type: text/plain; charset=utf-8\n\n";
  32         #print $cgi->header;
  33
  34         my @p = $cgi->param();
  35         warn "Params: " . Dumper(\@p);
  36
  37         my $method = $cgi->param("method");
  38         my $service = $cgi->param("service");
  39
  40         my $err = undef;
  41
  42         if( ! $service || ! $method ) {
  43                 $err = {
  44                         is_err  => 1,
  45                         err_msg => "Service name and method name required to fulfil request",
  46                 };
  47         }
  48
  49         if($err) {
  50                 print  JSON->perl2JSON($err);
  51                 return Apache2::Const::OK;
  52         }
  53
  54         my @param_array;
  55         my %param_hash;
  56
  57         warn "here\n";
  58
  59         if(defined($cgi->param("param"))) {
  60                 for my $param ( $cgi->param("param")) {
  61                         push( @param_array, JSON->JSON2perl( $param ));
  62                 }
  63         } else {
  64                 for my $param ($cgi->param()) {
  65                         $param_hash{$param} = JSON->JSON2perl($cgi->param($param))
  66                                 unless( $param eq "method" or $param eq "service" );
  67                 }
  68         }
  69
  70
  71         if( @param_array ) {
  72                 perform_method($service, $method, @param_array);
  73         } else {
  74                 perform_method($service, $method, %param_hash);
  75         }
  76
  77         return Apache2::Const::OK;
  78 }
  79
  80 sub child_init_handler {
  81         OpenSRF::System->bootstrap_client(
  82                 config_file => "/pines/conf/web_bootstrap.conf" );
  83 }
  84
  85
  86 sub perform_method {
  87
  88         my ($service, $method, @params) = @_;
  89
  90         warn "performing method $method for service $service with params @params\n";
  91
  92         my $session;
  93
  94         if($session_hash{$service} ) {
  95
  96                 $session = $session_hash{$service};
  97                 $session->{web_count} += 1;
  98
  99                 if( $session->{web_count} > MAX_SESSION_REQUESTS) {
 100                         $session->disconnect();
 101                         $session->{web_count} = 1;
 102                 }
 103
 104         } else {
 105
 106                 $session = OpenSRF::AppSession->create($service);
 107                 $session_hash{$service} = $session;
 108                 $session->{web_count} = 1;
 109
 110         }
 111
 112         my $request = $session->request( $method, @params );
 113
 114         my @results;
 115         while( my $response = $request->recv(20) ) {
 116
 117                 if( UNIVERSAL::isa( $response, "Error" )) {
 118                         warn "Received exception: " . $response->stringify . "\n";
 119                         my $err = {
 120                                 is_err  => 1,
 121                                 err_msg => "Error Completing Request:\n " .
 122                                         "Service: $service \nMethod: $method \nParams: @params \n" .
 123                                         $response->stringify() . "\n",
 124                         };
 125                         print JSON->perl2JSON($err);
 126                         $request->finish();
 127                         return 0;
 128                 }
 129
 130                 my $content = $response->content;
 131                 push @results, $content;
 132         }
 133
 134
 135         if(!$request->complete) {
 136                 warn "ERROR Completing Request";
 137                 my $err = {
 138                         is_err  => 1,
 139                         err_msg => "Error Completing Request:\n ".
 140                                 "Service: $service \nMethod: $method \nParams: @params \n" .
 141                                 "request->complete test failed in OpenILS::Web::Method\n"
 142                 };
 143                 print JSON->perl2JSON($err);
 144                 $request->finish();
 145                 return 0;
 146         }
 147
 148         $request->finish();
 149         $session->finish();
 150
 151         warn "Results: \n";
 152         warn Dumper \@results;
 153
 154         print JSON->perl2JSON( \@results );
 155
 156         return 1;
 157 }
 158
 159
 160 1;