File: | blib/lib/OpenSRF/DomainObject/oilsMessage.pm |
Coverage: | 15.6% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package 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 | |||||||
9 | OpenSRF::Utils::JSON->register_class_hint(hint => 'osrfMessage', name => 'OpenSRF::DomainObject::oilsMessage', type => 'hash'); | ||||||
10 | |||||||
11 | sub toString { | ||||||
12 | 0 | 0 | my $self = shift; | ||||
13 | 0 | return OpenSRF::Utils::JSON->perl2JSON($self); | |||||
14 | } | ||||||
15 | |||||||
16 | sub 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 | |||||||
45 | my $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 | |||||||
60 | sub 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 | |||||||
80 | sub 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 | |||||||
98 | sub 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 | |||||||
116 | sub 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 | |||||||
134 | sub 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 | |||||||
159 | sub 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 | |||||||
177 | sub 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 !!! | ||||||
219 | sub 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. | ||||||
270 | sub 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 | |||||||
337 | 1; |