Initial revision
[OpenSRF.git] / 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