OpenSRF/examples/math_shell.pl

   1 #!/usr/bin/perl -w
   2 use strict;use warnings;
   3 use OpenILS::System;
   4 use OpenILS::Utils::Config;
   5 use OpenILS::DomainObject::oilsMethod;
   6 use OpenILS::DomainObject::oilsPrimitive;
   7 use OpenILS::EX qw/:try/;
   8 $| = 1;
   9
  10 # ----------------------------------------------------------------------------------------
  11 # Simple math shell where you can test the transport system.
  12 # Enter simple, binary equations ony using +, -, *, and /
  13 # Example: # 1+1
  14 # Usage: % perl math_shell.pl
  15 # ----------------------------------------------------------------------------------------
  16
  17 # load the config
  18 my $config = OpenILS::Utils::Config->current;
  19
  20 # connect to the transport (jabber) server
  21 OpenILS::System->bootstrap_client();
  22
  23 # build the AppSession object.
  24 my $session = OpenILS::AppSession->create(
  25         "math", username => 'math_bench', secret => '12345' );
  26
  27 # launch the shell
  28 print "type 'exit' or 'quit' to leave the shell\n";
  29 print "# ";
  30 while( my $request = <> ) {
  31
  32         chomp $request ;
  33
  34         # exit loop if user enters 'exit' or 'quit'
  35         if( $request =~ /exit/i or $request =~ /quit/i ) { last; }
  36
  37         # figure out what the user entered
  38         my( $a, $mname, $b ) = parse_request( $request );
  39
  40         if( $a =~ /error/ ) {
  41                 print "Parse Error. Try again. \nExample # 1+1\n";
  42                 next;
  43         }
  44
  45
  46         try {
  47
  48                 # Connect to the MATH server
  49                 if( ! ($session->connect()) ) { die "Connect timed out\n"; }
  50
  51         } catch OpenILS::EX with {
  52                 my $e = shift;
  53                 die "* * Connection Failed with:\n$e";
  54         };
  55
  56         my $method = OpenILS::DomainObject::oilsMethod->new( method => $mname );
  57         $method->params( $a, $b );
  58
  59         my $req;
  60         my $resp;
  61
  62         try {
  63                 $req = $session->request( $method );
  64
  65                 # we know that this request only has a single reply
  66                 # if your expecting a 'stream' of results, you can
  67                 # do: while( $resp = $req->recv( timeout => 10 ) ) {}
  68                 $resp = $req->recv( timeout => 10 );
  69
  70         } catch OpenILS::EX with {
  71
  72                 # Any transport layer or server problems will launch an exception
  73                 my $e = shift;
  74                 die "ERROR Receiving\n $e";
  75
  76         } catch Error with {
  77
  78                 # something just died somethere
  79                 my $e = shift;
  80                 die "Caught unknown error: $e";
  81         };
  82
  83         if ( $resp ) {
  84                 # ----------------------------------------------------------------------------------------
  85                 # $resp is an OpenILS::DomainObject::oilsResponse object. $resp->content() returns whatever
  86                 # data the object has.  If the server returns an exception that we're meant to see, then
  87                 # the data will be an exception object.  In this case, barring any exception, we know that
  88                 # the data is an OpenILS::DomainObject::oilsScalar object which has a value() method
  89                 # that returns a perl scalar.  For us, that scalar is just a number.
  90                 # ----------------------------------------------------------------------------------------
  91
  92                 if( UNIVERSAL::isa( $resp, "OpenILS::EX" ) ) {
  93                                 throw $resp;
  94                 }
  95
  96                 my $ret = $resp->content();
  97                 print $ret->value();
  98         }
  99
 100         $req->finish();
 101
 102         print "\n# ";
 103
 104 }
 105
 106 # disconnect from the MATH server
 107 $session->kill_me();
 108 exit;
 109
 110 # ------------------------------------------------------------------------------------
 111 # parse the user input string
 112 # returns a list of the form (first param, operation, second param)
 113 # These operations are what the MATH server recognizes as method names
 114 # ------------------------------------------------------------------------------------
 115 sub parse_request {
 116         my $string = shift;
 117         my $op;
 118         my @ops;
 119
 120         while( 1 ) {
 121
 122                 @ops = split( /\+/, $string );
 123                 if( @ops > 1 ) { $op = "add"; last; }
 124
 125                 @ops = split( /\-/, $string );
 126                 if( @ops > 1 ) { $op = "sub"; last; }
 127
 128                 @ops = split( /\*/, $string );
 129                 if( @ops > 1 ) { $op = "mult", last; }
 130
 131                 @ops = split( /\//, $string );
 132                 if( @ops > 1 ) { $op = "div"; last; }
 133
 134                 return ("error");
 135         }
 136
 137         return ($ops[0], $op, $ops[1]);
 138 }
 139