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