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;