1 package OpenSRF::Application;
3 use OpenSRF::AppSession;
4 use OpenSRF::DomainObject::oilsMethod;
5 use OpenSRF::DomainObject::oilsResponse qw/:status/;
6 use OpenSRF::Utils::Logger qw/:level/;
8 use Time::HiRes qw/time/;
9 use vars qw/$_app $log %_METHODS/;
10 use OpenSRF::EX qw/:try/;
14 $log = 'OpenSRF::Utils::Logger';
17 our @pending_requests;
19 sub application_implementation {
27 $log->error( "Error loading application_implementation: $app -> $@", ERROR);
36 my ($self, $session, $app_msg) = @_;
42 $log->debug( "In Application::handler()", DEBUG );
44 my $app = $self->application_implementation;
47 $log->debug( "Application is $app", DEBUG);
49 $log->debug( "Message is ".$app_msg->toString(1), INTERNAL);
52 if ($session->last_message_type eq 'REQUEST') {
53 $log->debug( "We got a REQUEST: ". $app_msg->method, INFO );
55 my $method_name = $app_msg->method;
56 $log->debug( " * Looking up $method_name inside $app", DEBUG);
58 my $method_proto = $session->last_message_protocol;
59 $log->debug( " * Method API Level [$method_proto]", DEBUG);
61 my $coderef = $app->method_lookup( $method_name, $method_proto );
64 $session->status( OpenSRF::DomainObject::oilsMethodException->new() );
68 $log->debug( " (we got coderef $coderef", DEBUG);
70 unless ($session->continue_request) {
72 OpenSRF::DomainObject::oilsConnectStatus->new(
73 statusCode => STATUS_REDIRECTED(),
74 status => 'Disconnect on max requests' ) );
80 my @args = $app_msg->params;
81 my $appreq = OpenSRF::AppRequest->new( $session );
83 $log->debug( "in_request = $in_request : [" . $appreq->threadTrace."]", DEBUG );
85 $log->debug( "Pushing onto pending requests: " . $appreq->threadTrace, DEBUG );
86 push @pending_requests, [ $appreq, \@args, $coderef ];
93 $log->debug( "Executing coderef for {$method_name -> ".join(', ', @args)."}", INTERNAL );
98 $resp = $coderef->run( $appreq, @args);
99 my $time = sprintf '%.3f', time() - $start;
100 $log->debug( "Method duration for {$method_name -> ".join(', ', @args)."}: ". $time, DEBUG );
102 $log->debug( "Calling respond_complete: ". $resp->toString(), INTERNAL );
103 $appreq->respond_complete( $resp );
105 $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
106 statusCode => STATUS_COMPLETE(),
107 status => 'Request Complete' ) );
111 $e = $e->{-text} || $e->message if (ref $e);
112 my $sess_id = $session->session_id;
114 OpenSRF::DomainObject::oilsMethodException->new(
115 statusCode => STATUS_INTERNALSERVERERROR(),
116 status => " *** Call to [$method_name] failed for session ".
117 "[$sess_id], thread trace [".$appreq->threadTrace."]:\n".$e
124 # ----------------------------------------------
127 # XXX may need this later
128 # $_->[1] = 1 for (@OpenSRF::AppSession::_CLIENT_CACHE);
132 $log->debug( "Pending Requests: " . scalar(@pending_requests), INTERNAL );
134 # cycle through queued requests
135 while( my $aref = shift @pending_requests ) {
140 my $response = $aref->[2]->run( $aref->[0], @{$aref->[1]} );
141 my $time = sprintf '%.3f', time - $start;
142 $log->debug( "Method duration for {[".$aref->[2]->name." -> ".join(', ',@{$aref->[1]}).'}: '.$time, DEBUG );
144 $appreq = $aref->[0];
145 if( ref( $response ) ) {
146 $log->debug( "Calling respond_complete: ". $response->toString(), INTERNAL );
147 $appreq->respond_complete( $response );
149 $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
150 statusCode => STATUS_COMPLETE(),
151 status => 'Request Complete' ) );
153 $log->debug( "Executed: " . $appreq->threadTrace, DEBUG );
157 OpenSRF::DomainObject::oilsMethodException->new(
158 statusCode => STATUS_INTERNALSERVERERROR(),
159 status => "Call to [".$aref->[2]->name."] faild: ".$e->{-text}
168 my $res = OpenSRF::DomainObject::oilsMethodException->new;
169 $session->send('ERROR', $res);
174 $log->debug( "Pushing ". $app_msg->toString ." onto queue", INTERNAL );
175 $session->push_queue([ $app_msg, $session->last_threadTrace ]);
178 $session->last_message_type('');
179 $session->last_message_protocol('');
184 sub register_method {
186 my $app = ref($self) || $self;
189 throw OpenSRF::DomainObject::oilsMethodException unless ($args{method});
191 $args{protocol} ||= 1;
192 $args{api_name} ||= $app . '.' . $args{method};
193 $args{code} ||= \&{$app . '::' . $args{method}};
195 $_METHODS{$args{api_name}} = bless \%args => $app;
202 my $proto = shift || 1;
204 my $class = ref($self) || $self;
206 $log->debug("Specialized lookup of [$method] in [$class]", DEBUG);
207 $log->debug("Available methods\n".Dumper(\%_METHODS), INTERNAL);
209 if (exists $_METHODS{$method}) {
210 $log->debug("Looks like we found [$method]", DEBUG);
211 my $meth = $_METHODS{$method} if ($_METHODS{$method}{protocol} == $proto);
212 $log->debug("Method object is ".Dumper($meth), INTERNAL);
223 if ( !ref($req) || !UNIVERSAL::isa($req, 'OpenSRF::AppRequest') ) {
224 $log->debug("Creating a SubRequest object", DEBUG);
226 $req = OpenSRF::AppSubrequest->new;
228 $log->debug("This is a top level request", DEBUG);
231 my $resp = $self->{code}->($self, $req, @_);
233 if ( ref($req) and UNIVERSAL::isa($req, 'OpenSRF::AppSubrequest') ) {
234 $req->respond($resp) if ($resp);
235 for my $r ( $req->responses ) {
236 $log->debug("A SubRequest object is responding with $r", DEBUG);
238 return $req->responses;
240 $log->debug("A top level Request object is responding $resp", DEBUG);