3bec97c5d1e4d8552bd510ea2fee6355f96c377d
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / WWW / Method.pm.in
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 fulfill 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 => "@sysconfdir@/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 # This module appears unfinshed and/or obsolete with many unconditional warns/dumps.
159 # File is not referenced elsewhere in the codebase.  Candidate for deletion.
160
161 1;