13 $Data::Dumper::Indent = 1;
14 my $host = 'http://localhost';
19 'verbose' => \$verbose,
23 $host =~ /^\S+:\/\// or $host = 'http://' . $host;
24 $host =~ /:\d+$/ or $host .= ':9191';
28 print STDERR "Getting " . (shift) . " from input\n";
29 my $json = join("", <STDIN>);
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);
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';
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';
55 # ELSE: return vivified non-class hashes, all arrays, and anything that isn't a hash or array ref
60 print "Trying host: $host\n";
64 my $client = new RPC::XML::Client($host);
65 $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
68 print "User-agent: ", Dumper($client->useragent);
69 print "Request: ", Dumper($client->request);
71 foreach ($client->request->header_field_names) {
72 print "\t$_ =>", $client->request->header($_), "\n";
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') {
80 @commands > 1 and print STDERR "Ignoring commands after $command\n";
82 my $type = $command eq 'json2edi' ? 'JSON' : 'EDI';
83 while ($string = get_in($type)) { # assignment
85 if ($command eq 'json2edi') {
86 $resp = $client->send_request('json2edi', $string);
87 print "# $command Response: \n", Dumper($resp);
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);
93 warn "Response does not have a payload value!";
96 if ($resp->is_fault) {
97 print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
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";
106 print STDERR "\n########## We were able to decode and perl-ify the JSON\n";
108 print STDERR "\n########## ERROR: Failed to decode and perl-ify the JSON\n";
110 print "# $command Response: \n", $command eq 'edi2perl' ? Dumper($perl) : $parser->encode($parsed);
116 print STDERR "Sending request: \n ", join("\n ", @commands), "\n\n";
117 my $resp = $client->send_request(@commands);
123 print STDERR "Return is " . ref($resp), "\n";
124 # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
126 print Dumper ($_), "\n";
128 foreach (qw(code faultcode)) {
129 my $code = $resp->{$_};
131 print " ", ucfirst($_), ": ";
132 print $code ? $code->value : 'UNKNOWN';
137 print STDERR "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
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;
143 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";