fixing session timeout bug
[Evergreen.git] / 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;