LP1831390: combobox and date-select implement ControlValueAccessor
[Evergreen.git] / 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 JSON::XS;
10 use Data::Dumper;
11
12 # DEFAULTS
13 $Data::Dumper::Indent = 1;
14 my $host = 'http://localhost';
15 my $verbose = 0;
16
17 GetOptions(
18     'host=s'  => \$host,
19     'verbose' => \$verbose,
20 );
21
22 # CLEANUP
23 $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
24 $host =~ /:\d+$/     or $host .= ':9191';
25 $host .= '/EDI';
26
27 sub get_in {
28     print STDERR "Getting " . (shift) . " from input\n";
29     my $json = join("", <STDIN>);
30     $json or return;
31     print $json, "\n";
32     chomp $json;
33     return $json;
34 }
35
36 sub nice_string {
37     my $string = shift or return '';
38     my $head   = @_ ? shift : 100;
39     my $tail   = @_ ? shift : 25;
40     (length($string) < $head + $tail) and return $string;
41     return substr($string,0,$head) . " ...\n... " . substr($string, -1*$tail);
42 }
43
44 sub JSONObject2Perl {
45     my $obj = shift;
46     if ( ref $obj eq 'HASH' ) { # is a hash w/o class marker; simply revivify innards
47         for my $k (keys %$obj) {
48             $obj->{$k} = JSONObject2Perl($obj->{$k}) unless ref $obj->{$k} eq 'JSON::XS::Boolean';
49         }
50     } elsif ( ref $obj eq 'ARRAY' ) {
51         for my $i (0..scalar(@$obj) - 1) {
52             $obj->[$i] = JSONObject2Perl($obj->[$i]) unless ref $obj->[$i] eq 'JSON::XS::Boolean';
53         }
54     }
55     # ELSE: return vivified non-class hashes, all arrays, and anything that isn't a hash or array ref
56     return $obj;
57 }
58
59 # MAIN
60 print "Trying host: $host\n";
61
62 my $parser;
63
64 my $client = new RPC::XML::Client($host);
65 $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
66
67 if ($verbose) {
68     print "User-agent: ", Dumper($client->useragent);
69     print "Request: ", Dumper($client->request);
70     print "Headers: \n";
71     foreach ($client->request->header_field_names) {
72         print "\t$_ =>", $client->request->header($_), "\n";
73     }
74 }
75
76 my @commands = @ARGV ? @ARGV : 'system.listMethods';
77 my $command  = lc $commands[0];
78 if ($command eq 'json2edi' or $command eq 'edi2json' or $command eq 'edi2perl') {
79     shift;
80     @commands > 1 and print STDERR "Ignoring commands after $command\n";
81     my $string;
82     my $type = $command eq 'json2edi' ? 'JSON' : 'EDI';
83     while ($string = get_in($type)) {  # assignment
84         my $resp;
85         if ($command eq 'json2edi') {
86             $resp = $client->send_request('json2edi', $string);
87             print "# $command Response: \n", Dumper($resp);
88         } else {
89             $string =~ s/ORDRSP:0(:...:UN::)/ORDRSP:D$1/ and print STDERR "Corrected broken data 'ORDRSP:0' ==> 'ORDRSP:D'\n";
90             $resp = $client->send_request('edi2json', $string);
91         }
92         unless ($resp) {
93             warn "Response does not have a payload value!";
94             next;
95         }
96         if ($resp->is_fault) {
97             print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
98             next;
99         }
100         if ($command ne 'json2edi') {   # like the else of the first conditional
101             $parser ||= JSON::XS->new()->pretty(1)->ascii(1)->allow_nonref(1)->space_before(0);    # get it once
102             $verbose and print Dumper($resp);
103             my $parsed = $parser->decode($resp->value) or warn "Failed to decode response payload value";
104             my $perl   = JSONObject2Perl($parsed)      or warn "Failed to decode and create perl object from JSON";
105             if ($perl) {
106                 print STDERR "\n########## We were able to decode and perl-ify the JSON\n";
107             } else {
108                 print STDERR "\n########## ERROR: Failed to decode and perl-ify the JSON\n";
109             }
110             print "# $command Response: \n", $command eq 'edi2perl' ? Dumper($perl) : $parser->encode($parsed);
111         }
112     }
113     exit;
114
115
116 print STDERR "Sending request: \n    ", join("\n    ", @commands), "\n\n";
117 my $resp = $client->send_request(@commands);
118
119 print Dumper($resp);
120 exit;
121
122 if (ref $resp) {
123     print STDERR "Return is " . ref($resp), "\n";
124     # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
125     foreach (@$resp) {
126         print Dumper ($_), "\n";
127     }
128     foreach (qw(code faultcode)) {
129         my $code = $resp->{$_};
130         if ($code) {
131             print "    ", ucfirst($_), ": ";
132             print $code ? $code->value : 'UNKNOWN';
133         }
134         print "\n";
135     }
136 } else {
137     print STDERR "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
138 }
139 $verbose and print Dumper($resp);
140 $verbose and print "\nKEYS (level 1):\n",
141     map {sprintf "%12s: %s\n", $_, scalar $resp->{$_}->value} sort keys %$resp;
142
143 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";
144