Foundations of Action/Triger-based telephony,
[working/Evergreen.git] / Open-ILS / src / asterisk / pbx-daemon / 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 .= ':10080';
23
24 # MAIN
25 print "Trying host: $host\n";
26
27 my $client = new RPC::XML::Client($host);
28
29 my $insertblock = <<END_OF_CHUNK ;
30 Channel: zap1/614260xxxx
31 Context: overdue-test
32 MaxRetries: 1
33 RetryTime: 60
34 WaitTime: 30
35 Extension: 10
36 Archive: 1
37 Set: items=2
38 Set: titlestring=Akira, Huckleberry Finn
39 END_OF_CHUNK
40
41 my @commands;
42 if (scalar(@ARGV)) {
43     foreach(@ARGV) {
44         push @commands, $_;
45         $_ eq 'inject' and push @commands, $insertblock;
46     }
47 } else {
48     push @commands, 'retrieve';    # default
49 }
50
51 print "Sending request: \n    ", join("\n    ", @commands), "\n\n";
52 my $resp = $client->send_request(@commands);
53
54 if (ref $resp) {
55     print "Return is " . ref($resp), "\n";
56     # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
57     foreach (qw(code faultcode)) {
58         my $code = $resp->{$_};
59         if ($code) {
60             print "    ", ucfirst($_), ": ";
61             print $code ? $code->value : 'UNKNOWN';
62         }
63         print "\n";
64     }
65 } else {
66     print "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
67 }
68 $verbose and print Dumper($resp);
69 $verbose and print "\nKEYS (level 1):\n",
70     map {sprintf "%12s: %s\n", $_, scalar $resp->{$_}->value} sort keys %$resp;
71
72 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";