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

   1 package OpenILS::WWW::Method;
   2 use strict; use warnings;
   3
   4 use Apache2 ();
   5 use Apache::Log;
   6 use Apache::Const -compile => qw(OK REDIRECT :log);
   7 use APR::Const    -compile => qw(:error SUCCESS);
   8 use Apache::RequestRec ();
   9 use Apache::RequestIO ();
  10 use Apache::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         my $apache = shift;
  26         my $cgi = CGI->new( $apache );
  27
  28         my $method = $cgi->param("method");
  29         my $service = $cgi->param("service");
  30
  31         my @a = $cgi->param();
  32
  33         my @param_array;
  34         my %param_hash;
  35
  36         if(defined($cgi->param("__param"))) {
  37                 for my $param ( $cgi->param("__param")) {
  38                         push( @param_array, JSON->JSON2perl( $param ));
  39                 }
  40         } else {
  41                 for my $param ($cgi->param()) {
  42                         $param_hash{$param} = $cgi->param($param)
  43                                 unless( $param eq "method" or $param eq "service" );
  44                 }
  45         }
  46
  47         print "Content-type: text/plain; charset=utf-8\n\n";
  48
  49         if( @param_array ) {
  50                 perform_method($service, $method, @param_array);
  51         } else {
  52                 perform_method($service, $method, %param_hash);
  53         }
  54
  55         use Data::Dumper;
  56         warn JSON->perl2JSON( \@param_array );
  57         warn "===============\n";
  58         warn Dumper \@param_array;
  59
  60         return Apache::OK;
  61 }
  62
  63 sub child_init_handler {
  64         OpenSRF::System->bootstrap_client(
  65                         config_file => "/pines/conf/bootstrap.conf" );
  66 }
  67
  68
  69 sub perform_method {
  70
  71         my ($service, $method, @params) = @_;
  72
  73         warn "performing method $method for service $service with params @params\n";
  74
  75         my $session;
  76
  77         if($session_hash{$service} ) {
  78
  79                 $session = $session_hash{$service};
  80                 $session->{web_count} += 1;
  81
  82                 if( $session->{web_count} > MAX_SESSION_REQUESTS) {
  83                         $session->disconnect();
  84                         $session->{web_count} = 1;
  85                 }
  86
  87         } else {
  88
  89                 $session = OpenSRF::AppSession->create($service);
  90                 $session_hash{$service} = $session;
  91                 $session->{web_count} = 1;
  92
  93         }
  94
  95         my $request = $session->request( $method, @params );
  96
  97         my @results;
  98         while( my $response = $request->recv(20) ) {
  99
 100                 if( UNIVERSAL::isa( $response, "Error" )) {
 101                         warn "Received exception: " . $response->stringify . "\n";
 102                         print  JSON->perl2JSON($response->stringify);
 103                         $request->finish();
 104                         return 0;
 105                 }
 106
 107                 my $content = $response->content;
 108                 push @results, $content;
 109         }
 110
 111
 112         if(!$request->complete) {
 113                 warn "<b>ERROR Completing Request</b>";
 114                 print JSON->perl2JSON("<b>ERROR Completing Request</b>");
 115                 $request->finish();
 116                 return 0;
 117         }
 118
 119         $request->finish();
 120         $session->finish();
 121
 122         print JSON->perl2JSON( \@results );
 123
 124         return 1;
 125 }
 126
 127
 128 1;