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 1;
 166
 167
 168
 169 #-------------------------------------------------------------------------------
 170
 171
 172
 173 package OpenSRF::DomainObject::oilsResult;
 174 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 175 use OpenSRF::DomainObject::oilsPrimitive;
 176 use base 'OpenSRF::DomainObject::oilsResponse';
 177 use vars qw/$status $statusCode/;
 178
 179
 180 $status = 'OK';
 181 $statusCode = STATUS_OK;
 182
 183 =head1 NAME
 184
 185 OpenSRF::DomainObject::oilsResult
 186
 187 =head1 SYNOPSIS
 188
 189 use OpenSRF::DomainObject::oilsResponse;
 190
 191  .... do stuff, create $object ...
 192
 193 my $res = OpenSRF::DomainObject::oilsResult->new;
 194
 195 $res->content($object)
 196
 197 $session->respond( $res );
 198
 199 =head1 ABSTRACT
 200
 201 This is the base class for encapuslating RESULT messages send from the server
 202 to a client.  It is a subclass of B<OpenSRF::DomainObject::oilsResponse>, and
 203 sets B<status> to C<OK> and B<statusCode> to C<STATUS_OK>.
 204
 205 =head1 METHODS
 206
 207 =head2 OpenSRF::DomainObject::oilsMessage->content( [$new_content] )
 208
 209 =over 4
 210
 211 Sets or gets the content of the response.  This should be exactly one object
 212 of (sub)type domainObject or domainObjectCollection.
 213
 214 =back
 215
 216 =cut
 217
 218 sub content {
 219         my $self = shift;
 220         my $new_content = shift;
 221
 222         my ($content) = $self->getChildrenByTagName('oils:domainObject');
 223
 224         if (defined $new_content) {
 225                 $new_content = OpenSRF::DomainObject::oilsScalar->new( JSON->perl2JSON( $new_content ) );
 226
 227                 $self->removeChild($content) if ($content);
 228                 $self->appendChild($new_content);
 229         }
 230
 231
 232         $new_content = $content if ($content);
 233
 234         return JSON->JSON2perl($new_content->textContent) if $new_content;
 235 }
 236
 237 =head1 SEE ALSO
 238
 239 B<OpenSRF::DomainObject::oilsResponse>
 240
 241 =cut
 242
 243 1;
 244
 245
 246
 247 #-------------------------------------------------------------------------------
 248
 249
 250
 251 package OpenSRF::DomainObject::oilsException;
 252 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 253 use OpenSRF::EX;
 254 use base qw/OpenSRF::EX OpenSRF::DomainObject::oilsResponse/;
 255 use vars qw/$status $statusCode/;
 256 use Error;
 257
 258 sub message {
 259         my $self = shift;
 260         return '<' . $self->statusCode . '>  ' . $self->status;
 261 }
 262
 263 sub new {
 264         my $class = shift;
 265         return $class->OpenSRF::DomainObject::oilsResponse::new( @_ );
 266 }
 267
 268
 269 =head1 NAME
 270
 271 OpenSRF::DomainObject::oilsException
 272
 273 =head1 SYNOPSIS
 274
 275 use OpenSRF::DomainObject::oilsResponse;
 276
 277 ...
 278
 279 # something breaks.
 280
 281 $client->send( 'ERROR', OpenSRF::DomainObject::oilsException->new( status => "ARRRRRRG!" ) );
 282
 283 =head1 ABSTRACT
 284
 285 The base class for Exception messages sent between client and server.  This
 286 is implemented on top of the C<OpenSRF::DomainObject::oilsResponse> class, and
 287 sets the default B<status> to C<Exception occured> and B<statusCode> to C<STATUS_BADREQUEST>.
 288
 289 =cut
 290
 291 $status = 'Exception occured';
 292 $statusCode = STATUS_INTERNALSERVERERROR;
 293
 294 package OpenSRF::DomainObject::oilsConnectException;
 295 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 296 use OpenSRF::EX;
 297 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 298 use vars qw/$status $statusCode/;
 299
 300 =head1 NAME
 301
 302 OpenSRF::DomainObject::oilsConnectException
 303
 304 =head1 SYNOPSIS
 305
 306 use OpenSRF::DomainObject::oilsResponse;
 307
 308 ...
 309
 310 # something breaks while connecting.
 311
 312 $client->send( 'ERROR', new OpenSRF::DomainObject::oilsConnectException );
 313
 314 =head1 ABSTRACT
 315
 316 The class for Exceptions that occur durring the B<CONNECT> phase of a session.  This
 317 is implemented on top of the C<OpenSRF::DomainObject::oilsException> class, and
 318 sets the default B<status> to C<Connect Request Failed> and B<statusCode> to C<STATUS_FORBIDDEN>.
 319
 320 =head1 SEE ALSO
 321
 322 B<OpenSRF::DomainObject::oilsException>
 323
 324 =cut
 325
 326
 327 $status = 'Connect Request Failed';
 328 $statusCode = STATUS_FORBIDDEN;
 329
 330 package OpenSRF::DomainObject::oilsMethodException;
 331 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 332 use base 'OpenSRF::DomainObject::oilsException';
 333 use vars qw/$status $statusCode/;
 334
 335 =head1 NAME
 336
 337 OpenSRF::DomainObject::oilsMehtodException
 338
 339 =head1 SYNOPSIS
 340
 341 use OpenSRF::DomainObject::oilsResponse;
 342
 343 ...
 344
 345 # something breaks while looking up or starting
 346 # a method call.
 347
 348 $client->send( 'ERROR', new OpenSRF::DomainObject::oilsMethodException );
 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_NOTFOUND>.
 355
 356 =head1 SEE ALSO
 357
 358 B<OpenSRF::DomainObject::oilsException>
 359
 360 =cut
 361
 362
 363 $status = 'Method not found';
 364 $statusCode = STATUS_NOTFOUND;
 365
 366 # -------------------------------------------
 367
 368 package OpenSRF::DomainObject::oilsServerError;
 369 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 370 use base 'OpenSRF::DomainObject::oilsException';
 371 use vars qw/$status $statusCode/;
 372
 373 $status = 'Internal Server Error';
 374 $statusCode = STATUS_INTERNALSERVERERROR;
 375
 376 # -------------------------------------------
 377
 378
 379
 380
 381
 382 package OpenSRF::DomainObject::oilsBrokenSession;
 383 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 384 use OpenSRF::EX;
 385 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 386 use vars qw/$status $statusCode/;
 387 $status = "Request on Disconnected Session";
 388 $statusCode = STATUS_EXPFAILED;
 389
 390 package OpenSRF::DomainObject::oilsXMLParseError;
 391 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 392 use OpenSRF::EX;
 393 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 394 use vars qw/$status $statusCode/;
 395 $status = "XML Parse Error";
 396 $statusCode = STATUS_EXPFAILED;
 397
 398 package OpenSRF::DomainObject::oilsAuthException;
 399 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 400 use OpenSRF::EX;
 401 use base qw/OpenSRF::DomainObject::oilsException OpenSRF::EX::ERROR/;
 402 use vars qw/$status $statusCode/;
 403 $status = "Authentication Failure";
 404 $statusCode = STATUS_FORBIDDEN;
 405
 406 1;