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";