src/perlmods/OpenSRF/DomainObject/oilsResponse.pm

   1 package OpenSRF::DomainObject::oilsResponse;
   2 use vars qw/@EXPORT_OK %EXPORT_TAGS/;
   3 use Exporter;
   4 use JSON;
   5 use base qw/OpenSRF::DomainObject Exporter/;
   6 use OpenSRF::Utils::Logger qw/:level/;
   7
   8 BEGIN {
   9 @EXPORT_OK = qw/STATUS_CONTINUE STATUS_OK STATUS_ACCEPTED
  10                                         STATUS_BADREQUEST STATUS_UNAUTHORIZED STATUS_FORBIDDEN
  11                                         STATUS_NOTFOUND STATUS_NOTALLOWED STATUS_TIMEOUT
  12                                         STATUS_INTERNALSERVERERROR STATUS_NOTIMPLEMENTED
  13                                         STATUS_VERSIONNOTSUPPORTED STATUS_REDIRECTED
  14                                         STATUS_EXPFAILED STATUS_COMPLETE/;
  15
  16 %EXPORT_TAGS = (
  17         status => [ qw/STATUS_CONTINUE STATUS_OK STATUS_ACCEPTED
  18                                         STATUS_BADREQUEST STATUS_UNAUTHORIZED STATUS_FORBIDDEN
  19                                         STATUS_NOTFOUND STATUS_NOTALLOWED STATUS_TIMEOUT
  20                                         STATUS_INTERNALSERVERERROR STATUS_NOTIMPLEMENTED
  21                                         STATUS_VERSIONNOTSUPPORTED STATUS_REDIRECTED
  22                                         STATUS_EXPFAILED STATUS_COMPLETE/ ],
  23 );
  24
  25 }
  26
  27 =head1 NAME
  28
  29 OpenSRF::DomainObject::oilsResponse
  30
  31 =head1 SYNOPSIS
  32
  33 use OpenSRF::DomainObject::oilsResponse qw/:status/;
  34
  35 my $resp = OpenSRF::DomainObject::oilsResponse->new;
  36
  37 $resp->status( 'a status message' );
  38
  39 $resp->statusCode( STATUS_CONTINUE );
  40
  41 $client->respond( $resp );
  42
  43 =head1 ABSTRACT
  44
  45 OpenSRF::DomainObject::oilsResponse implements the base class for all Application
  46 layer messages send between the client and server.
  47
  48 =cut
  49
  50 sub STATUS_CONTINUE             { return 100 }
  51
  52 sub STATUS_OK                           { return 200 }
  53 sub STATUS_ACCEPTED             { return 202 }
  54 sub STATUS_COMPLETE             { return 205 }
  55
  56 sub STATUS_REDIRECTED   { return 307 }
  57
  58 sub STATUS_BADREQUEST   { return 400 }
  59 sub STATUS_UNAUTHORIZED { return 401 }
  60 sub STATUS_FORBIDDEN            { return 403 }
  61 sub STATUS_NOTFOUND             { return 404 }
  62 sub STATUS_NOTALLOWED   { return 405 }
  63 sub STATUS_TIMEOUT              { return 408 }
  64 sub STATUS_EXPFAILED            { return 417 }
  65
  66 sub STATUS_INTERNALSERVERERROR  { return 500 }
  67 sub STATUS_NOTIMPLEMENTED                       { return 501 }
  68 sub STATUS_VERSIONNOTSUPPORTED  { return 505 }
  69
  70 my $log = 'OpenSRF::Utils::Logger';
  71
  72 sub new {
  73         my $class = shift;
  74         $class = ref($class) || $class;
  75
  76         my $default_status = eval "\$${class}::status";
  77         my $default_statusCode = eval "\$${class}::statusCode";
  78
  79         my %args = (    status => $default_status,
  80                         statusCode => $default_statusCode,
  81                         @_ );
  82
  83         return $class->SUPER::new( %args );
  84 }
  85
  86 sub status {
  87         my $self = shift;
  88         return $self->_attr_get_set( status => shift );
  89 }
  90
  91 sub statusCode {
  92         my $self = shift;
  93         return $self->_attr_get_set( statusCode => shift );
  94 }
  95
  96
  97 #-------------------------------------------------------------------------------
  98
  99
 100
 101 package OpenSRF::DomainObject::oilsStatus;
 102 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 103 use base 'OpenSRF::DomainObject::oilsResponse';
 104 use vars qw/$status $statusCode/;
 105
 106 =head1 NAME
 107
 108 OpenSRF::DomainObject::oilsException
 109
 110 =head1 SYNOPSIS
 111
 112 use OpenSRF::DomainObject::oilsResponse;
 113
 114 ...
 115
 116 # something happens.
 117
 118 $client->status( OpenSRF::DomainObject::oilsStatus->new );
 119
 120 =head1 ABSTRACT
 121
 122 The base class for Status messages sent between client and server.  This
 123 is implemented on top of the C<OpenSRF::DomainObject::oilsResponse> class, and
 124 sets the default B<status> to C<Status> and B<statusCode> to C<STATUS_OK>.
 125
 126 =cut
 127
 128 $status = 'Status';
 129 $statusCode = STATUS_OK;
 130
 131 package OpenSRF::DomainObject::oilsConnectStatus;
 132 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 133 use base 'OpenSRF::DomainObject::oilsStatus';
 134 use vars qw/$status $statusCode/;
 135
 136 =head1 NAME
 137
 138 OpenSRF::DomainObject::oilsConnectStatus
 139
 140 =head1 SYNOPSIS
 141
 142 use OpenSRF::DomainObject::oilsResponse;
 143
 144 ...
 145
 146 # something happens.
 147
 148 $client->status( new OpenSRF::DomainObject::oilsConnectStatus );
 149
 150 =head1 ABSTRACT
 151
 152 The class for Stati relating to the connection status of a session.  This
 153 is implemented on top of the C<OpenSRF::DomainObject::oilsStatus> class, and
 154 sets the default B<status> to C<Connection Successful> and B<statusCode> to C<STATUS_OK>.
 155
 156 =head1 SEE ALSO
 157
 158 B<OpenSRF::DomainObject::oilsStatus>
 159
 160 =cut
 161
 162 $status = 'Connection Successful';
 163 $statusCode = STATUS_OK;
 164
 165
 166
 167
 168 package OpenSRF::DomainObject::oilsContinueStatus;
 169 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 170 use base 'OpenSRF::DomainObject::oilsStatus';
 171 use vars qw/$status $statusCode/;
 172
 173 =head1 NAME
 174
 175 OpenSRF::DomainObject::oilsContinueStatus
 176
 177 =head1 SYNOPSIS
 178
 179 use OpenSRF::DomainObject::oilsResponse;
 180
 181 ...
 182
 183 # something happens.
 184
 185 $client->status( new OpenSRF::DomainObject::oilsContinueStatus );
 186
 187 =head1 ABSTRACT
 188
 189 Implements the STATUS_CONTINUE message, informing the client that it should
 190 continue to wait for a response to it's request.
 191
 192 =head1 SEE ALSO
 193
 194 B<OpenSRF::DomainObject::oilsStatus>
 195
 196 =cut
 197
 198 $status = 'Please hold.  Creating response...';
 199 $statusCode = STATUS_CONTINUE;
 200
 201 1;
 202
 203
 204
 205 #-------------------------------------------------------------------------------
 206
 207
 208
 209 package OpenSRF::DomainObject::oilsResult;
 210 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 211 use OpenSRF::DomainObject::oilsPrimitive;
 212 use base 'OpenSRF::DomainObject::oilsResponse';
 213 use vars qw/$status $statusCode/;
 214
 215
 216 $status = 'OK';
 217 $statusCode = STATUS_OK;
 218
 219 =head1 NAME
 220
 221 OpenSRF::DomainObject::oilsResult
 222
 223 =head1 SYNOPSIS
 224
 225 use OpenSRF::DomainObject::oilsResponse;
 226
 227  .... do stuff, create $object ...
 228
 229 my $res = OpenSRF::DomainObject::oilsResult->new;
 230
 231 $res->content($object)
 232
 233 $session->respond( $res );
 234
 235 =head1 ABSTRACT
 236
 237 This is the base class for encapuslating RESULT messages send from the server
 238 to a client.  It is a subclass of B<OpenSRF::DomainObject::oilsResponse>, and
 239 sets B<status> to C<OK> and B<statusCode> to C<STATUS_OK>.
 240
 241 =head1 METHODS
 242
 243 =head2 OpenSRF::DomainObject::oilsMessage->content( [$new_content] )
 244
 245 =over 4
 246
 247 Sets or gets the content of the response.  This should be exactly one object
 248 of (sub)type domainObject or domainObjectCollection.
 249
 250 =back
 251
 252 =cut
 253
 254 sub content {
 255         my $self = shift;
 256         my $new_content = shift;
 257
 258         my ($content) = $self->getChildrenByTagName('oils:domainObject');
 259
 260         if (defined $new_content) {
 261                 $new_content = OpenSRF::DomainObject::oilsScalar->new( JSON->perl2JSON( $new_content ) );
 262
 263                 $self->removeChild($content) if ($content);
 264                 $self->appendChild($new_content);
 265         }
 266
 267
 268         $new_content = $content if ($content);
 269
 270         return JSON->JSON2perl($new_content->textContent) if $new_content;
 271 }
 272
 273 =head1 SEE ALSO
 274
 275 B<OpenSRF::DomainObject::oilsResponse>
 276
 277 =cut
 278
 279 1;
 280
 281
 282
 283 #-------------------------------------------------------------------------------
 284
 285
 286
 287 package OpenSRF::DomainObject::oilsException;
 288 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 289 use OpenSRF::EX;
 290 use base qw/OpenSRF::EX OpenSRF::DomainObject::oilsResponse/;
 291 use vars qw/$status $statusCode/;
 292 use Error;
 293
 294 sub message {
 295         my $self = shift;
 296         return '<' . $self->statusCode . '>  ' . $self->status;
 297 }
 298
 299 sub new {
 300         my $class = shift;
 301         return $class->OpenSRF::DomainObject::oilsResponse::new( @_ );
 302 }
 303
 304
 305 =head1 NAME
 306
 307 OpenSRF::DomainObject::oilsException
 308
 309 =head1 SYNOPSIS
 310
 311 use OpenSRF::DomainObject::oilsResponse;
 312
 313 ...
 314
 315 # something breaks.
 316
 317 $client->send( 'ERROR', OpenSRF::DomainObject::oilsException->new( status => "ARRRRRRG!" ) );
 318
 319 =head1 ABSTRACT
 320
 321 The base class for Exception messages sent between client and server.  This
 322 is implemented on top of the C<OpenSRF::DomainObject::oilsResponse> class, and
 323 sets the default B<status> to C<Exception occured> and B<statusCode> to C<STATUS_BADREQUEST>.
 324
 325 =cut
 326
 327 $status = 'Exception occured';
 328 $statusCode = STATUS_INTERNALSERVERERROR;
 329
 330 package OpenSRF::DomainObject::oilsConnectException;
 331 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 332 use OpenSRF::EX;
 333 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 334 use vars qw/$status $statusCode/;
 335
 336 =head1 NAME
 337
 338 OpenSRF::DomainObject::oilsConnectException
 339
 340 =head1 SYNOPSIS
 341
 342 use OpenSRF::DomainObject::oilsResponse;
 343
 344 ...
 345
 346 # something breaks while connecting.
 347
 348 $client->send( 'ERROR', new OpenSRF::DomainObject::oilsConnectException );
 349
 350 =head1 ABSTRACT
 351
 352 The class for Exceptions that occur durring the B<CONNECT> phase of a session.  This
 353 is implemented on top of the C<OpenSRF::DomainObject::oilsException> class, and
 354 sets the default B<status> to C<Connect Request Failed> and B<statusCode> to C<STATUS_FORBIDDEN>.
 355
 356 =head1 SEE ALSO
 357
 358 B<OpenSRF::DomainObject::oilsException>
 359
 360 =cut
 361
 362
 363 $status = 'Connect Request Failed';
 364 $statusCode = STATUS_FORBIDDEN;
 365
 366 package OpenSRF::DomainObject::oilsMethodException;
 367 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 368 use base 'OpenSRF::DomainObject::oilsException';
 369 use vars qw/$status $statusCode/;
 370
 371 =head1 NAME
 372
 373 OpenSRF::DomainObject::oilsMehtodException
 374
 375 =head1 SYNOPSIS
 376
 377 use OpenSRF::DomainObject::oilsResponse;
 378
 379 ...
 380
 381 # something breaks while looking up or starting
 382 # a method call.
 383
 384 $client->send( 'ERROR', new OpenSRF::DomainObject::oilsMethodException );
 385
 386 =head1 ABSTRACT
 387
 388 The class for Exceptions that occur durring the B<CONNECT> phase of a session.  This
 389 is implemented on top of the C<OpenSRF::DomainObject::oilsException> class, and
 390 sets the default B<status> to C<Connect Request Failed> and B<statusCode> to C<STATUS_NOTFOUND>.
 391
 392 =head1 SEE ALSO
 393
 394 B<OpenSRF::DomainObject::oilsException>
 395
 396 =cut
 397
 398
 399 $status = 'Method not found';
 400 $statusCode = STATUS_NOTFOUND;
 401
 402 # -------------------------------------------
 403
 404 package OpenSRF::DomainObject::oilsServerError;
 405 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 406 use base 'OpenSRF::DomainObject::oilsException';
 407 use vars qw/$status $statusCode/;
 408
 409 $status = 'Internal Server Error';
 410 $statusCode = STATUS_INTERNALSERVERERROR;
 411
 412 # -------------------------------------------
 413
 414
 415
 416
 417
 418 package OpenSRF::DomainObject::oilsBrokenSession;
 419 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 420 use OpenSRF::EX;
 421 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 422 use vars qw/$status $statusCode/;
 423 $status = "Request on Disconnected Session";
 424 $statusCode = STATUS_EXPFAILED;
 425
 426 package OpenSRF::DomainObject::oilsXMLParseError;
 427 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 428 use OpenSRF::EX;
 429 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 430 use vars qw/$status $statusCode/;
 431 $status = "XML Parse Error";
 432 $statusCode = STATUS_EXPFAILED;
 433
 434 package OpenSRF::DomainObject::oilsAuthException;
 435 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 436 use OpenSRF::EX;
 437 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 438 use vars qw/$status $statusCode/;
 439 $status = "Authentication Failure";
 440 $statusCode = STATUS_FORBIDDEN;
 441
 442 1;