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

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