File Coverage

File:blib/lib/OpenSRF/DomainObject/oilsMessage.pm
Coverage:15.6%

linestmtbrancondsubpodtimecode
1package OpenSRF::DomainObject::oilsMessage;
2
9
9
9
95
37
112
use OpenSRF::Utils::JSON;
3
9
9
9
88
32
85
use OpenSRF::AppSession;
4
9
9
9
112
37
54
use OpenSRF::DomainObject::oilsResponse qw/:status/;
5
9
9
9
62
34
72
use OpenSRF::Utils::Logger qw/:level/;
6
9
9
9
9
9
9
67
35
67
64
36
66
use warnings; use strict;
7
9
9
9
82
45
59
use OpenSRF::EX qw/:try/;
8
9OpenSRF::Utils::JSON->register_class_hint(hint => 'osrfMessage', name => 'OpenSRF::DomainObject::oilsMessage', type => 'hash');
10
11sub toString {
12
0
0
        my $self = shift;
13
0
        return OpenSRF::Utils::JSON->perl2JSON($self);
14}
15
16sub new {
17
0
0
        my $self = shift;
18
0
        my $class = ref($self) || $self;
19
0
        my %args = @_;
20
0
        return bless \%args => $class;
21}
22
23
24 - 43
=head1 NAME

OpenSRF::DomainObject::oilsMessage

=head1

use OpenSRF::DomainObject::oilsMessage;

my $msg = OpenSRF::DomainObject::oilsMessage->new( type => 'CONNECT' );

$msg->payload( $domain_object );

=head1 ABSTRACT

OpenSRF::DomainObject::oilsMessage is used internally to wrap data sent
between client and server.  It provides the structure needed to authenticate
session data, and also provides the logic needed to unwrap session data and 
pass this information along to the Application Layer.

=cut
44
45my $log = 'OpenSRF::Utils::Logger';
46
47 - 58
=head1 METHODS

=head2 OpenSRF::DomainObject::oilsMessage->type( [$new_type] )

=over 4

Used to specify the type of message.  One of
B<CONNECT, REQUEST, RESULT, STATUS, ERROR, or DISCONNECT>.

=back

=cut
59
60sub type {
61
0
1
        my $self = shift;
62
0
        my $val = shift;
63
0
        $self->{type} = $val if (defined $val);
64
0
        return $self->{type};
65}
66
67 - 78
=head2 OpenSRF::DomainObject::oilsMessage->api_level( [$new_api_level] )

=over 4

Used to specify the api_level of message.  Currently, only api_level C<1> is
supported.  This will be used to check that messages are well-formed, and as
a hint to the Application as to which version of a method should fulfill a
REQUEST message.

=back

=cut
79
80sub api_level {
81
0
1
        my $self = shift;
82
0
        my $val = shift;
83
0
        $self->{api_level} = $val if (defined $val);
84
0
        return $self->{api_level};
85}
86
87 - 96
=head2 OpenSRF::DomainObject::oilsMessage->sender_locale( [$locale] );

=over 4

Sets or gets the current message locale hint.  Useful for telling the
server how you see the world.

=back

=cut
97
98sub sender_locale {
99
0
1
        my $self = shift;
100
0
        my $val = shift;
101
0
        $self->{locale} = $val if (defined $val);
102
0
        return $self->{locale};
103}
104
105 - 114
=head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );

=over 4

Sets or gets the current message sequence identifier, or thread trace number,
for a message.  Useful as a debugging aid, but that's about it.

=back

=cut
115
116sub threadTrace {
117
0
1
        my $self = shift;
118
0
        my $val = shift;
119
0
        $self->{threadTrace} = $val if (defined $val);
120
0
        return $self->{threadTrace};
121}
122
123 - 132
=head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace

=over 4

Increments the threadTrace component of a message.  This is automatic when
using the normal session processing stack.

=back

=cut
133
134sub update_threadTrace {
135
0
1
        my $self = shift;
136
0
        my $tT = $self->threadTrace;
137
138
0
        $tT ||= 0;
139
0
        $tT++;
140
141
0
        $log->debug("Setting threadTrace to $tT",DEBUG);
142
143
0
        $self->threadTrace($tT);
144
145
0
        return $tT;
146}
147
148 - 157
=head2 OpenSRF::DomainObject::oilsMessage->payload( [$new_payload] )

=over 4

Sets or gets the payload of a message.  This should be exactly one object
of (sub)type domainObject or domainObjectCollection.

=back

=cut
158
159sub payload {
160
0
1
        my $self = shift;
161
0
        my $val = shift;
162
0
        $self->{payload} = $val if (defined $val);
163
0
        return $self->{payload};
164}
165
166 - 175
=head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )

=over 4

Used by the message processing stack to set session state information from the current
message, and then sends control (via the payload) to the Application layer.

=back

=cut
176
177sub handler {
178
0
1
        my $self = shift;
179
0
        my $session = shift;
180
181
0
        my $mtype = $self->type;
182
0
        my $locale = $self->sender_locale || '';
183
0
        my $api_level = $self->api_level || 1;
184
0
        my $tT = $self->threadTrace;
185
186
0
    $log->debug("Message locale is $locale", DEBUG);
187
188
0
        $session->last_message_type($mtype);
189
0
        $session->last_message_api_level($api_level);
190
0
        $session->last_threadTrace($tT);
191
0
        $session->session_locale($locale);
192
193
0
        $log->debug(" Received api_level => [$api_level], MType => [$mtype], ".
194                        "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]");
195
196
0
        my $val;
197
0
        if ( $session->endpoint == $session->SERVER() ) {
198
0
                $val = $self->do_server( $session, $mtype, $api_level, $tT );
199
200        } elsif ($session->endpoint == $session->CLIENT()) {
201
0
                $val = $self->do_client( $session, $mtype, $api_level, $tT );
202        }
203
204
0
        if( $val ) {
205
0
                return OpenSRF::Application->handler($session, $self->payload);
206        } else {
207
0
                $log->debug("Request was handled internally", DEBUG);
208        }
209
210
0
        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 !!!
219sub do_server {
220
0
0
        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
0
0
    if( $mtype eq 'STATUS' or $mtype eq 'RESULT' ) { return 0; }
227
228
229
0
        if ($mtype eq 'DISCONNECT') {
230
0
                $session->disconnect;
231
0
                $session->kill_me;
232
0
                return 0;
233        }
234
235
0
        if ($session->state == $session->CONNECTING()) {
236
237
0
                if($mtype ne "CONNECT" and $session->stateless) {
238
0
                        return 1; #pass the message up the stack
239                }
240
241                # the transport layer thinks this is a new connection. is it?
242
0
                unless ($mtype eq 'CONNECT') {
243
0
                        $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
244
245
0
                        my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
246                                        status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
247                        );
248
249
0
                        $session->status($res);
250
0
                        $session->kill_me;
251
0
                        return 0;
252
253                }
254
255
0
                my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
256
0
                $session->status($res);
257
0
                $session->state( $session->CONNECTED );
258
259
0
                return 0;
260        }
261
262
263
0
        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.
270sub do_client {
271
272
0
0
        my( $self, $session , $mtype, $api_level, $tT) = @_;
273
274
275
0
        if ($mtype eq 'STATUS') {
276
277
0
                if ($self->payload->statusCode == STATUS_OK) {
278
0
                        $session->state($session->CONNECTED);
279
0
                        $log->debug("We connected successfully to ".$session->app);
280
0
                        return 0;
281                }
282
283
0
                if ($self->payload->statusCode == STATUS_TIMEOUT) {
284
0
                        $session->state( $session->DISCONNECTED );
285
0
                        $session->reset;
286
0
                        $session->connect;
287
0
                        $session->push_resend( $session->app_request($self->threadTrace) );
288
0
                        $log->debug("Disconnected because of timeout");
289
0
                        return 0;
290
291                } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
292
0
                        $session->state( $session->DISCONNECTED );
293
0
                        $session->reset;
294
0
                        $session->connect;
295
0
                        $session->push_resend( $session->app_request($self->threadTrace) );
296
0
                        $log->debug("Disconnected because of redirect", WARN);
297
0
                        return 0;
298
299                } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
300
0
                        $session->state( $session->DISCONNECTED );
301
0
                        $log->debug("Disconnected because of mangled session", WARN);
302
0
                        $session->reset;
303
0
                        $session->push_resend( $session->app_request($self->threadTrace) );
304
0
                        return 0;
305
306                } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
307
0
                        $session->reset_request_timeout($self->threadTrace);
308
0
                        return 0;
309
310                } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
311
0
                        my $req = $session->app_request($self->threadTrace);
312
0
                        $req->complete(1) if ($req);
313
0
                        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
0
        if( $self->payload and $self->payload->isa( "ERROR" ) ) {
326
0
                if ($session->raise_remote_errors) {
327
0
                        $self->payload->throw();
328                }
329        }
330
331
0
        $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id );
332
333
0
        return 1;
334
335}
336
3371;