src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm

   1 package OpenSRF::DomainObject::oilsMessage;
   2 use OpenSRF::Utils::JSON;
   3 use OpenSRF::AppSession;
   4 use OpenSRF::DomainObject::oilsResponse qw/:status/;
   5 use OpenSRF::Utils::Logger qw/:level/;
   6 use warnings; use strict;
   7 use OpenSRF::EX qw/:try/;
   8
   9 OpenSRF::Utils::JSON->register_class_hint(hint => 'osrfMessage', name => 'OpenSRF::DomainObject::oilsMessage', type => 'hash');
  10
  11 sub toString {
  12         my $self = shift;
  13         return OpenSRF::Utils::JSON->perl2JSON($self);
  14 }
  15
  16 sub new {
  17         my $self = shift;
  18         my $class = ref($self) || $self;
  19         my %args = @_;
  20         return bless \%args => $class;
  21 }
  22
  23
  24 =head1 NAME
  25
  26 OpenSRF::DomainObject::oilsMessage
  27
  28 =head1
  29
  30 use OpenSRF::DomainObject::oilsMessage;
  31
  32 my $msg = OpenSRF::DomainObject::oilsMessage->new( type => 'CONNECT' );
  33
  34 $msg->payload( $domain_object );
  35
  36 =head1 ABSTRACT
  37
  38 OpenSRF::DomainObject::oilsMessage is used internally to wrap data sent
  39 between client and server.  It provides the structure needed to authenticate
  40 session data, and also provides the logic needed to unwrap session data and
  41 pass this information along to the Application Layer.
  42
  43 =cut
  44
  45 my $log = 'OpenSRF::Utils::Logger';
  46
  47 =head1 METHODS
  48
  49 =head2 OpenSRF::DomainObject::oilsMessage->type( [$new_type] )
  50
  51 =over 4
  52
  53 Used to specify the type of message.  One of
  54 B<CONNECT, REQUEST, RESULT, STATUS, ERROR, or DISCONNECT>.
  55
  56 =back
  57
  58 =cut
  59
  60 sub type {
  61         my $self = shift;
  62         my $val = shift;
  63         $self->{type} = $val if (defined $val);
  64         return $self->{type};
  65 }
  66
  67 =head2 OpenSRF::DomainObject::oilsMessage->api_level( [$new_api_level] )
  68
  69 =over 4
  70
  71 Used to specify the api_level of message.  Currently, only api_level C<1> is
  72 supported.  This will be used to check that messages are well-formed, and as
  73 a hint to the Application as to which version of a method should fulfill a
  74 REQUEST message.
  75
  76 =back
  77
  78 =cut
  79
  80 sub api_level {
  81         my $self = shift;
  82         my $val = shift;
  83         $self->{api_level} = $val if (defined $val);
  84         return $self->{api_level};
  85 }
  86
  87 =head2 OpenSRF::DomainObject::oilsMessage->sender_locale( [$locale] );
  88
  89 =over 4
  90
  91 Sets or gets the current message locale hint.  Useful for telling the
  92 server how you see the world.
  93
  94 =back
  95
  96 =cut
  97
  98 sub sender_locale {
  99         my $self = shift;
 100         my $val = shift;
 101         $self->{locale} = $val if (defined $val);
 102         return $self->{locale};
 103 }
 104
 105 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
 106
 107 =over 4
 108
 109 Sets or gets the current message sequence identifier, or thread trace number,
 110 for a message.  Useful as a debugging aid, but that's about it.
 111
 112 =back
 113
 114 =cut
 115
 116 sub threadTrace {
 117         my $self = shift;
 118         my $val = shift;
 119         $self->{threadTrace} = $val if (defined $val);
 120         return $self->{threadTrace};
 121 }
 122
 123 =head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace
 124
 125 =over 4
 126
 127 Increments the threadTrace component of a message.  This is automatic when
 128 using the normal session processing stack.
 129
 130 =back
 131
 132 =cut
 133
 134 sub update_threadTrace {
 135         my $self = shift;
 136         my $tT = $self->threadTrace;
 137
 138         $tT ||= 0;
 139         $tT++;
 140
 141         $log->debug("Setting threadTrace to $tT",DEBUG);
 142
 143         $self->threadTrace($tT);
 144
 145         return $tT;
 146 }
 147
 148 =head2 OpenSRF::DomainObject::oilsMessage->payload( [$new_payload] )
 149
 150 =over 4
 151
 152 Sets or gets the payload of a message.  This should be exactly one object
 153 of (sub)type domainObject or domainObjectCollection.
 154
 155 =back
 156
 157 =cut
 158
 159 sub payload {
 160         my $self = shift;
 161         my $val = shift;
 162         $self->{payload} = $val if (defined $val);
 163         return $self->{payload};
 164 }
 165
 166 =head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )
 167
 168 =over 4
 169
 170 Used by the message processing stack to set session state information from the current
 171 message, and then sends control (via the payload) to the Application layer.
 172
 173 =back
 174
 175 =cut
 176
 177 sub handler {
 178         my $self = shift;
 179         my $session = shift;
 180
 181         my $mtype = $self->type;
 182         my $locale = $self->sender_locale || '';
 183         my $api_level = $self->api_level || 1;
 184         my $tT = $self->threadTrace;
 185
 186     $log->debug("Message locale is $locale", DEBUG);
 187
 188         $session->last_message_type($mtype);
 189         $session->last_message_api_level($api_level);
 190         $session->last_threadTrace($tT);
 191         $session->session_locale($locale);
 192
 193         $log->debug(" Received api_level => [$api_level], MType => [$mtype], ".
 194                         "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]");
 195
 196         my $val;
 197         if ( $session->endpoint == $session->SERVER() ) {
 198                 $val = $self->do_server( $session, $mtype, $api_level, $tT );
 199
 200         } elsif ($session->endpoint == $session->CLIENT()) {
 201                 $val = $self->do_client( $session, $mtype, $api_level, $tT );
 202         }
 203
 204         if( $val ) {
 205                 return OpenSRF::Application->handler($session, $self->payload);
 206         } else {
 207                 $log->debug("Request was handled internally", DEBUG);
 208         }
 209
 210         return 1;
 211
 212 }
 213
 214
 215
 216 # handle server side message processing
 217
 218 # !!! Returning 0 means that we don't want to pass ourselves up to the message layer !!!
 219 sub do_server {
 220         my( $self, $session, $mtype, $api_level, $tT ) = @_;
 221
 222         # A Server should never receive STATUS or RESULT messages.  If so, we drop them.
 223         # This is to keep STATUS/RESULT's from dead client sessions from creating new server
 224         # sessions which send mangled session exceptions to backends for messages
 225         # that they are not aware of any more.
 226     if( $mtype eq 'STATUS' or $mtype eq 'RESULT' ) { return 0; }
 227
 228
 229         if ($mtype eq 'DISCONNECT') {
 230                 $session->disconnect;
 231                 $session->kill_me;
 232                 return 0;
 233         }
 234
 235         if ($session->state == $session->CONNECTING()) {
 236
 237                 if($mtype ne "CONNECT" and $session->stateless) {
 238                         return 1; #pass the message up the stack
 239                 }
 240
 241                 # the transport layer thinks this is a new connection. is it?
 242                 unless ($mtype eq 'CONNECT') {
 243                         $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
 244
 245                         my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
 246                                         status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
 247                         );
 248
 249                         $session->status($res);
 250                         $session->kill_me;
 251                         return 0;
 252
 253                 }
 254
 255                 my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
 256                 $session->status($res);
 257                 $session->state( $session->CONNECTED );
 258
 259                 return 0;
 260         }
 261
 262
 263         return 1;
 264
 265 }
 266
 267
 268 # Handle client side message processing. Return 1 when the the message should be pushed
 269 # up to the application layer.  return 0 otherwise.
 270 sub do_client {
 271
 272         my( $self, $session , $mtype, $api_level, $tT) = @_;
 273
 274
 275         if ($mtype eq 'STATUS') {
 276
 277                 if ($self->payload->statusCode == STATUS_OK) {
 278                         $session->state($session->CONNECTED);
 279                         $log->debug("We connected successfully to ".$session->app);
 280                         return 0;
 281                 }
 282
 283                 if ($self->payload->statusCode == STATUS_TIMEOUT) {
 284                         $session->state( $session->DISCONNECTED );
 285                         $session->reset;
 286                         $session->connect;
 287                         $session->push_resend( $session->app_request($self->threadTrace) );
 288                         $log->debug("Disconnected because of timeout");
 289                         return 0;
 290
 291                 } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
 292                         $session->state( $session->DISCONNECTED );
 293                         $session->reset;
 294                         $session->connect;
 295                         $session->push_resend( $session->app_request($self->threadTrace) );
 296                         $log->debug("Disconnected because of redirect", WARN);
 297                         return 0;
 298
 299                 } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
 300                         $session->state( $session->DISCONNECTED );
 301                         $log->debug("Disconnected because of mangled session", WARN);
 302                         $session->reset;
 303                         $session->push_resend( $session->app_request($self->threadTrace) );
 304                         return 0;
 305
 306                 } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
 307                         $session->reset_request_timeout($self->threadTrace);
 308                         return 0;
 309
 310                 } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
 311                         my $req = $session->app_request($self->threadTrace);
 312                         $req->complete(1) if ($req);
 313                         return 0;
 314                 }
 315
 316                 # add more STATUS handling code here (as 'elsif's), for Message layer status stuff
 317
 318                 #$session->state( $session->DISCONNECTED() );
 319                 #$session->reset;
 320
 321         } elsif ($session->state == $session->CONNECTING()) {
 322                 # This should be changed to check the type of response (is it a connectException?, etc.)
 323         }
 324
 325         if( $self->payload and $self->payload->isa( "ERROR" ) ) {
 326                 if ($session->raise_remote_errors) {
 327                         $self->payload->throw();
 328                 }
 329         }
 330
 331         $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id );
 332
 333         return 1;
 334
 335 }
 336
 337 1;