12 my $host = 'http://localhost';
17 'verbose' => \$verbose,
21 $host =~ /^\S+:\/\// or $host = 'http://' . $host;
22 $host =~ /:\d+$/ or $host .= ':9191';
26 print "Getting " . (shift) . " from input\n";
27 my $json = join("", <STDIN>);
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);
43 print "Trying host: $host\n";
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);
50 foreach ($client->request->header_field_names) {
51 print "\t$_ =>", $client->request->header($_), "\n";
54 my @commands = @ARGV ? @ARGV : 'system.listMethods';
55 if ($commands[0] eq 'json2edi' or $commands[0] eq 'edi2json') {
57 @commands > 1 and print "Ignoring commands after $commands[0]\n";
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";
64 my $resp = $commands[0] eq 'json2edi' ?
65 $client->send_request('json2edi', $string) :
66 $client->send_request('edi2json', $string) ;
67 print "Response: ", Dumper($resp);
69 if ($resp->is_fault) {
70 print "\n\nERROR code ", $resp->code, " received:\n", nice_string($resp->string) . "\n...\n";
77 print "Sending request: \n ", join("\n ", @commands), "\n\n";
78 my $resp = $client->send_request(@commands);
84 print "Return is " . ref($resp), "\n";
85 # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
87 print Dumper ($_), "\n";
89 foreach (qw(code faultcode)) {
90 my $code = $resp->{$_};
92 print " ", ucfirst($_), ": ";
93 print $code ? $code->value : 'UNKNOWN';
98 print "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
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;
104 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";