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