src/perlmods/OpenSRF/Application/Demo/Math.pm

   1 package OpenILS::App::Math;
   2 use base qw/OpenILS::Application/;
   3 use OpenILS::Application;
   4 use OpenILS::Utils::Logger qw/:level/;
   5 use OpenILS::DomainObject::oilsResponse;
   6 use OpenILS::EX qw/:try/;
   7 use strict;
   8 use warnings;
   9
  10 sub DESTROY{}
  11
  12 our $log = 'OpenILS::Utils::Logger';
  13
  14 #sub method_lookup {
  15 #
  16 #       my( $class, $method_name, $method_proto ) = @_;
  17 #
  18 #       if( $method_name eq "add" ) {
  19 #               return \&add;
  20 #       }
  21
  22 #       if( $method_name eq "sub" ) {
  23 #               return \&sub;
  24 #       }
  25 #
  26 #       if( $method_name eq "mult" ) {
  27 #               return \&mult;
  28 #       }
  29 #
  30 #       if( $method_name eq "div" ) {
  31 #               return \&div;
  32 #       }
  33
  34 #       return undef;
  35 #
  36 #}
  37
  38 sub send_request {
  39
  40         my $method_name = shift;
  41         my @params = @_;
  42
  43         $log->debug( "Creating a client environment", DEBUG );
  44         my $session = OpenILS::AppSession->create(
  45                         "dbmath", sysname => 'math', secret => '12345' );
  46
  47         $log->debug( "Sending request to math server", INTERNAL );
  48
  49         my $method = OpenILS::DomainObject::oilsMethod->new( method => $method_name );
  50
  51         $method->params( @params );
  52
  53
  54         my $req;
  55         my $resp;
  56
  57
  58         try {
  59
  60                 for my $nn (0..1) {
  61                         my $vv = $session->connect();
  62                         if($vv) { last; }
  63                         if( $nn and !$vv ) {
  64                                 throw OpenILS::EX::CRITICAL ("DBMath connect attempt timed out");
  65                         }
  66                 }
  67
  68                 $req = $session->request( $method );
  69                 $resp = $req->recv(10);
  70
  71         } catch OpenILS::DomainObject::oilsAuthException with {
  72                 my $e = shift;
  73                 $e->throw();
  74         };
  75
  76         $log->error("response is $resp");
  77         if ( defined($resp) and $resp and $resp->class->isa('OpenILS::DomainObject::oilsResult') ){
  78
  79                 $log->debug( "Math server returned " . $resp->toString(1), INTERNAL );
  80                 $req->finish;
  81                 $session->finish;
  82                 return $resp;
  83
  84         } else {
  85
  86                 if( $resp ) { $log->debug( "Math received \n".$resp->toString(), ERROR ); }
  87                 else{ $log->debug( "Math received empty value", ERROR ); }
  88                 $req->finish;
  89                 $session->finish;
  90                 throw OpenILS::EX::ERROR ("Did not receive expected data from MathDB");
  91
  92         }
  93 }
  94
  95
  96 sub add_1_action { 1 };
  97 sub add_1 {
  98
  99         my $client = shift;
 100         my @args = @_;
 101         return send_request( "add", @args );
 102 }
 103
 104 sub sub_1_action { 1 };
 105 sub sub_1 {
 106         my $client = shift;
 107         my @args = @_;
 108         return send_request( "sub", @args );
 109 }
 110
 111 sub mult_1_action { 1 };
 112 sub mult_1 {
 113         my $client = shift;
 114         my @args = @_;
 115         return send_request( "mult", @args );
 116 }
 117
 118 sub div_1_action { 1 };
 119 sub div_1 {
 120         my $client = shift;
 121         my @args = @_;
 122         return send_request( "div", @args );
 123 }
 124
 125
 126 1;