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/;
7 use Time::HiRes qw/time/;
8 use vars qw/$_app $log %_METHODS/;
9 use OpenSRF::EX qw/:try/;
13 $log = 'OpenSRF::Utils::Logger';
16 our @pending_requests;
18 sub application_implementation {
26 $log->error( "Error loading application_implementation: $app -> $@", ERROR);
35 my ($self, $session, $app_msg) = @_;
37 $log->debug( "In Application::handler()", DEBUG );
39 my $app = $self->application_implementation;
42 $log->debug( "Application is $app", DEBUG);
44 $log->debug( "Message is ".$app_msg->toString(1), INTERNAL);
47 if ($session->last_message_type eq 'REQUEST') {
48 $log->debug( "We got a REQUEST: ". $app_msg->method, INFO );
50 my $method_name = $app_msg->method;
51 $log->debug( " * Looking up $method_name inside $app", DEBUG);
53 my $method_proto = $session->last_message_protocol;
54 $log->debug( " * Method API Level [$method_proto]", DEBUG);
56 my $coderef = $app->method_lookup( $method_name, $method_proto );
59 $session->status( OpenSRF::DomainObject::oilsMethodException->new() );
63 $log->debug( " (we got coderef $coderef", DEBUG);
65 unless ($session->continue_request) {
67 OpenSRF::DomainObject::oilsConnectStatus->new(
68 statusCode => STATUS_REDIRECTED(),
69 status => 'Disconnect on max requests' ) );
75 my @args = $app_msg->params;
76 my $appreq = OpenSRF::AppRequest->new( $session );
78 $log->debug( "in_request = $in_request : [" . $appreq->threadTrace."]", DEBUG );
80 $log->debug( "Pushing onto pending requests: " . $appreq->threadTrace, DEBUG );
81 push @pending_requests, [ $appreq, \@args, $coderef ];
88 $log->debug( "Executing coderef for {$method_name -> ".join(', ', @args)."}", INTERNAL );
93 $resp = $coderef->run( $appreq, @args);
94 my $time = sprintf '%.3f', time() - $start;
95 $log->debug( "Method duration for {$method_name -> ".join(', ', @args)."}: ". $time, DEBUG );
97 $log->debug( "Calling respond_complete: ". $resp->toString(), INTERNAL );
98 $appreq->respond_complete( $resp );
100 $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
101 statusCode => STATUS_COMPLETE(),
102 status => 'Request Complete' ) );
106 $e = $e->{-text} || $e->message if (ref $e);
107 my $sess_id = $session->session_id;
109 OpenSRF::DomainObject::oilsMethodException->new(
110 statusCode => STATUS_INTERNALSERVERERROR(),
111 status => " *** Call to [$method_name] failed for session ".
112 "[$sess_id], thread trace [".$appreq->threadTrace."]:\n".$e
119 # ----------------------------------------------
122 # XXX may need this later
123 # $_->[1] = 1 for (@OpenSRF::AppSession::_CLIENT_CACHE);
127 $log->debug( "Pending Requests: " . scalar(@pending_requests), INTERNAL );
129 # cycle through queued requests
130 while( my $aref = shift @pending_requests ) {
135 my $response = $aref->[2]->run( $aref->[0], @{$aref->[1]} );
136 my $time = sprintf '%.3f', time - $start;
137 $log->debug( "Method duration for {[".$aref->[2]->name." -> ".join(', ',@{$aref->[1]}).'}: '.$time, DEBUG );
139 $appreq = $aref->[0];
140 if( ref( $response ) ) {
141 $log->debug( "Calling respond_complete: ". $response->toString(), INTERNAL );
142 $appreq->respond_complete( $response );
144 $appreq->status( OpenSRF::DomainObject::oilsConnectStatus->new(
145 statusCode => STATUS_COMPLETE(),
146 status => 'Request Complete' ) );
148 $log->debug( "Executed: " . $appreq->threadTrace, DEBUG );
152 OpenSRF::DomainObject::oilsMethodException->new(
153 statusCode => STATUS_INTERNALSERVERERROR(),
154 status => "Call to [".$aref->[2]->name."] faild: ".$e->{-text}
163 my $res = OpenSRF::DomainObject::oilsMethodException->new;
164 $session->send('ERROR', $res);
169 $log->debug( "Pushing ". $app_msg->toString ." onto queue", INTERNAL );
170 $session->push_queue([ $app_msg, $session->last_threadTrace ]);
173 $session->last_message_type('');
174 $session->last_message_protocol('');
179 sub register_method {
181 my $app = ref($self) || $self;
184 throw OpenSRF::DomainObject::oilsMethodException unless ($args{method});
186 $args{protocol} ||= 1;
187 $args{api_name} ||= $app . '.' . $args{method};
188 $args{code} ||= \&{$app . '::' . $args{method}};
190 $_METHODS{$args{api_name}} = bless \%args => $app;
199 my $super_lookup = $self->SUPER::method_lookup($method,$proto);
200 return $super_lookup if (ref $super_lookup);
202 my $class = ref($self) || $self;
204 $log->debug("Specialized lookup of [$method] in [$class]", INTERNAL);
206 if (exists $_METHODS{$method}) {
207 return $_METHODS{$method} if ($_METHODS{$method}{protocol} == $proto);
215 $self->{code}->($self, @_);