Open-ILS/src/edi_translator/test_client.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 use warnings;
   5 use strict;
   6
   7 use Getopt::Long;
   8 use RPC::XML::Client;
   9 use Data::Dumper;
  10
  11 # DEFAULTS
  12 my $host = 'http://localhost';
  13 my $verbose = 0;
  14
  15 GetOptions(
  16     'host=s'  => \$host,
  17     'verbose' => \$verbose,
  18 );
  19
  20 # CLEANUP
  21 $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
  22 $host =~ /:\d+$/     or $host .= ':9191';
  23 $host .= '/EDI';
  24
  25 sub get_in {
  26     print "Getting " . (shift) . " from input\n";
  27     my $json = join("", <STDIN>);
  28     $json or return;
  29     print $json, "\n";
  30     chomp $json;
  31     return $json;
  32 }
  33
  34 sub nice_string {
  35     my $string = shift or return '';
  36     my $head   = @_ ? shift : 100;
  37     my $tail   = @_ ? shift : 25;
  38     (length($string) < $head + $tail) and return $string;
  39     return substr($string,0,$head) . " ...\n... " . substr($string, -1*$tail);
  40 }
  41
  42 # MAIN
  43 print "Trying host: $host\n";
  44
  45 my $client = new RPC::XML::Client($host);
  46 $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
  47 print "User-agent: ", Dumper($client->useragent);
  48 print "Request: ", Dumper($client->request);
  49 print "Headers: \n";
  50 foreach ($client->request->header_field_names) {
  51     print "\t$_ =>", $client->request->header($_), "\n";
  52 }
  53
  54 my @commands = @ARGV ? @ARGV : 'system.listMethods';
  55 if ($commands[0] eq 'json2edi' or $commands[0] eq 'edi2json') {
  56     shift;
  57     @commands > 1 and print "Ignoring commands after $commands[0]\n";
  58     my $string;
  59     my $type = $commands[0] eq 'json2edi' ? 'JSON' : 'EDI';
  60     while ($string = get_in($type)) {  # assignment
  61         if ($commands[0] ne 'json2edi') {
  62             $string =~ s/ORDRSP:0(:...:UN::)/ORDRSP:D$1/ and print "Corrected broken data 'ORDRSP:0' ==> 'ORDRSP:D'\n";
  63         }
  64         my $resp = $commands[0] eq 'json2edi' ?
  65                    $client->send_request('json2edi', $string) :
  66                    $client->send_request('edi2json', $string) ;
  67         print "Response: ", Dumper($resp);
  68         $resp or next;
  69         if ($resp->is_fault) {
  70             print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
  71             next;
  72         }
  73     }
  74     exit;
  75 }
  76
  77 print "Sending request: \n    ", join("\n    ", @commands), "\n\n";
  78 my $resp = $client->send_request(@commands);
  79
  80 print Dumper($resp);
  81 exit;
  82
  83 if (ref $resp) {
  84     print "Return is " . ref($resp), "\n";
  85     # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
  86     foreach (@$resp) {
  87         print Dumper ($_), "\n";
  88     }
  89     foreach (qw(code faultcode)) {
  90         my $code = $resp->{$_};
  91         if ($code) {
  92             print "    ", ucfirst($_), ": ";
  93             print $code ? $code->value : 'UNKNOWN';
  94         }
  95         print "\n";
  96     }
  97 } else {
  98     print "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
  99 }
 100 $verbose and print Dumper($resp);
 101 $verbose and print "\nKEYS (level 1):\n",
 102     map {sprintf "%12s: %s\n", $_, scalar $resp->{$_}->value} sort keys %$resp;
 103
 104 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";