New features for telephony currently in use at KCLS
[Evergreen.git] / Open-ILS / src / asterisk / pbx-daemon / test_client.pl
1 #!/usr/bin/perl
2
3
4 # 17 Feb 2012:
5 # A lot has changed with the other files in this directory, and regrettably
6 # I don't know to what extent this script works anymore.
7 #   - senator
8
9 use warnings;
10 use strict;
11
12 use Getopt::Long;
13 use RPC::XML::Client;
14 use Data::Dumper;
15
16 # DEFAULTS
17 my $host = 'http://localhost';
18 my $verbose = 0;
19
20 GetOptions(
21     'host=s'  => \$host,
22     'verbose' => \$verbose,
23 );
24
25 # CLEANUP
26 $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
27 $host =~ /:\d+$/     or $host .= ':10080';
28
29 # MAIN
30 print "Trying host: $host\n";
31
32 my $client = new RPC::XML::Client($host);
33
34 my $insertblock = <<END_OF_CHUNK ;
35 Channel: zap1/614260xxxx
36 Context: overdue-test
37 MaxRetries: 1
38 RetryTime: 60
39 WaitTime: 30
40 Extension: 10
41 Archive: 1
42 Set: items=2
43 Set: titlestring=Akira, Huckleberry Finn
44 END_OF_CHUNK
45
46 my @commands;
47 if (scalar(@ARGV)) {
48     foreach(@ARGV) {
49         push @commands, $_;
50         $_ eq 'inject' and push @commands, $insertblock;
51     }
52 } else {
53     push @commands, 'retrieve';    # default
54 }
55
56 print "Sending request: \n    ", join("\n    ", @commands), "\n\n";
57 my $resp = $client->send_request(@commands);
58
59 if (ref $resp) {
60     print "Return is " . ref($resp), "\n";
61     # print "Code: ", ($resp->{code}->as_string || 'UNKNOWN'), "\n";
62     foreach (qw(code faultcode)) {
63         my $code = $resp->{$_};
64         if ($code) {
65             print "    ", ucfirst($_), ": ";
66             print $code ? $code->value : 'UNKNOWN';
67         }
68         print "\n";
69     }
70 } else {
71     print "ERROR: unrecognized response:\n\n", Dumper($resp), "\n";
72 }
73 $verbose and print Dumper($resp);
74 $verbose and print "\nKEYS (level 1):\n",
75     map {sprintf "%12s: %s\n", $_, scalar $resp->{$_}->value} sort keys %$resp;
76
77 # print "spooled_filename: ", $resp->{spooled_filename}->value, "\n";