Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / Application.pm
1 package OpenSRF::Application;
2 use base qw/OpenSRF/;
3 use OpenSRF::AppSession;
4 use OpenSRF::DomainObject::oilsMethod;
5 use OpenSRF::DomainObject::oilsResponse qw/:status/;
6 use OpenSRF::Utils::Logger qw/:level/;
7 use Time::HiRes qw/time/;
8 use vars qw/$_app $log/;
9 use OpenSRF::EX qw/:try/;
10 use strict;
11 use warnings;
12
13 $log = 'OpenSRF::Utils::Logger';
14
15 our $in_request = 0;
16 our @pending_requests;
17
18 sub application_implementation {
19         my $self = shift;
20         my $app = shift;
21
22         if (defined $app) {
23                 $_app = $app;
24                 eval "use $_app;";
25                 if( $@ ) {
26                         $log->error( "Error loading application_implementation: $app -> $@", ERROR);
27                 }
28
29         }
30
31         return $_app;
32 }
33
34 sub handler {
35         my ($self, $session, $app_msg) = @_;
36
37         $log->debug( "In Application::handler()", DEBUG );
38
39         my $app = $self->application_implementation;
40
41         if( $app ) {
42                 $log->debug( "Application is $app", DEBUG);
43         }
44         $log->debug( "Message is ".$app_msg->toString(1), INTERNAL);
45
46
47         if ($session->last_message_type eq 'REQUEST') {
48                 $log->debug( "We got a REQUEST: ". $app_msg->method, INFO );
49
50                 my $method_name = $app_msg->method;
51                 $log->debug( " * Looking up $method_name inside $app", DEBUG);
52
53                 my $method_proto = $session->last_message_protocol;
54                 $log->debug( " * Method API Level [$method_proto]", DEBUG);
55
56                 my $coderef = $app->method_lookup( $method_name, $method_proto );
57
58                 unless ($coderef) {
59                         $session->status( OpenSRF::DomainObject::oilsMethodException->new() );
60                         return 1;
61                 }
62
63                 #if ( $session->client_auth->username || $session->client_auth->userid ) {
64                 #       unless ( $coderef->is_action ) {
65                 #               $session->status(
66                 #                       OpenSRF::DomainObject::oilsMethodException->new(
67                 #                                       statusCode => STATUS_NOTALLOWED(),
68                 #                                       status => "User cannot use [$method_name]" ) );
69                 #               return 1;
70                 #       }
71                 #}
72                         
73
74                 $log->debug( " (we got coderef $coderef", DEBUG);
75
76                 unless ($session->continue_request) {
77                         $session->status(
78                                 OpenSRF::DomainObject::oilsConnectStatus->new(
79                                                 statusCode => STATUS_REDIRECTED(),
80                                                 status => 'Disconnect on max requests' ) );
81                         $session->kill_me;
82                         return 1;
83                 }
84
85                 if (ref $coderef) {
86                         my @args = $app_msg->params;
87                         my $appreq = OpenSRF::AppRequest->new( $session );
88
89                         $log->debug( "in_request = $in_request : [" . $appreq->threadTrace."]", DEBUG );
90                         if( $in_request ) {
91                                 $log->debug( "Pushing onto pending requests: " . $appreq->threadTrace, DEBUG );
92                                 push @pending_requests, [ $appreq, \@args, $coderef ]; 
93                                 return 1;
94                         }
95
96
97                         $in_request++;
98
99                         $log->debug( "Executing coderef for {$method_name -> ".join(', ', @args)."}", INTERNAL );
100
101                         my $resp;
102                         try {
103                                 my $start = time();
104                                 $resp = $coderef->run( $appreq, @args); 
105                                 my $time = sprintf '%.3f', time() - $start;
106                                 $log->debug( "Method duration for {$method_name -> ".join(', ', @args)."}:  ". $time, DEBUG );
107                                 if( ref( $resp ) ) {
108                                         $log->debug( "Calling respond_complete: ". $resp->toString(), INTERNAL );
109                                         $appreq->respond_complete( $resp );
110                                 } else {
111                                         $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
112                                                                 statusCode => STATUS_COMPLETE(),
113                                                                 status => 'Request Complete' ) );
114                                 }
115                         } catch Error with {
116                                 my $e = shift;
117                                 $e = $e->{-text} || $e->message if (ref $e);
118                                 my $sess_id = $session->session_id;
119                                 $session->status(
120                                         OpenSRF::DomainObject::oilsMethodException->new(
121                                                         statusCode      => STATUS_INTERNALSERVERERROR(),
122                                                         status          => " *** Call to [$method_name] failed for session ".
123                                                                            "[$sess_id], thread trace [".$appreq->threadTrace."]:\n".$e
124                                         )
125                                 );
126                         };
127
128
129
130                         # ----------------------------------------------
131
132
133                         # XXX may need this later
134                         # $_->[1] = 1 for (@OpenSRF::AppSession::_CLIENT_CACHE);
135
136                         $in_request--;
137
138                         $log->debug( "Pending Requests: " . scalar(@pending_requests), INTERNAL );
139
140                         # cycle through queued requests
141                         while( my $aref = shift @pending_requests ) {
142                                 $in_request++;
143                                 my $resp;
144                                 try {
145                                         my $start = time;
146                                         my $response = $aref->[2]->run( $aref->[0], @{$aref->[1]} );
147                                         my $time = sprintf '%.3f', time - $start;
148                                         $log->debug( "Method duration for {[".$aref->[2]->name." -> ".join(', ',@{$aref->[1]}).'}:  '.$time, DEBUG );
149
150                                         $appreq = $aref->[0];   
151                                         if( ref( $response ) ) {
152                                                 $log->debug( "Calling respond_complete: ". $response->toString(), INTERNAL );
153                                                 $appreq->respond_complete( $response );
154                                         } else {
155                                                 $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
156                                                                         statusCode => STATUS_COMPLETE(),
157                                                                         status => 'Request Complete' ) );
158                                         }
159                                         $log->debug( "Executed: " . $appreq->threadTrace, DEBUG );
160                                 } catch Error with {
161                                         my $e = shift;
162                                         $session->status(
163                                                 OpenSRF::DomainObject::oilsMethodException->new(
164                                                                 statusCode => STATUS_INTERNALSERVERERROR(),
165                                                                 status => "Call to [".$aref->[2]->name."] faild:  ".$e->{-text}
166                                                 )
167                                         );
168                                 };
169                                 $in_request--;
170                         }
171
172                         return 1;
173                 } 
174                 my $res = OpenSRF::DomainObject::oilsMethodException->new;
175                 $session->send('ERROR', $res);
176                 $session->kill_me;
177                 return 1;
178
179         } else {
180                 $log->debug( "Pushing ". $app_msg->toString ." onto queue", INTERNAL );
181                 $session->push_queue([ $app_msg, $session->last_threadTrace ]);
182         }
183
184         $session->last_message_type('');
185         $session->last_message_protocol('');
186
187         return 1;
188 }
189
190 sub method_lookup {
191         my $self = shift;
192         my $method = shift;
193         my $proto = shift;
194
195         my $class = ref($self) || $self;
196
197         $log->debug("Looking up [$method] in [$self]", INTERNAL);
198         
199         my $obj = bless {} => $self;
200         if (my $coderef = $self->can("${method}_${proto}")) {
201                 $$obj{code} = $coderef;
202                 $$obj{name} = "${method}_${proto}";
203                 return $obj;
204         }
205         return undef;
206 }
207
208 sub run {
209         my $self = shift;
210         $self->{code}->(@_);
211 }
212
213 sub is_action {
214         my $self = shift;
215         if (my $can = $self->can($self->{name} . '_action')) {
216                 return $can->();
217         }
218         return 0;
219 }
220
221
222 1;