From f698692e8313b906749001a7fa62ec313e20ee1e Mon Sep 17 00:00:00 2001
From: "Nate Bargmann, N0NB" <n0nb@users.sourceforge.net>
Date: Thu, 28 Jan 2010 12:26:45 +0000
Subject: [PATCH] First cut as rewrite to make testctld.pl interactice ala
 rigctl.

git-svn-id: https://hamlib.svn.sourceforge.net/svnroot/hamlib/trunk@2816 7ae35d74-ebe9-4afe-98af-79ac388436b8
---
 tests/testctld.pl | 371 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 256 insertions(+), 115 deletions(-)

diff --git a/tests/testctld.pl b/tests/testctld.pl
index 0d1714797..5b5b283c5 100755
--- a/tests/testctld.pl
+++ b/tests/testctld.pl
@@ -8,10 +8,11 @@
 # It connects to the rigctld TCP port (default 4532) and queries the daemon
 # for some common rig information and sets some values.  It also aims to
 # provide a bit of example code for Perl scripting.
+#
+# This script requires that `rigctld' be invoked with the '-b'|'--block' option.
+# Details of the Block protocol can be found in the rigctld(8) manual page.
 
-# This script requires that `rigctld' be invoked with the '-b'|'block' option.
-# Details of the block protocol can be found in the rigctld(8) manual page.
-
+#############################################################################
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License
 # as published by the Free Software Foundation; either version 2
@@ -25,12 +26,19 @@
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+#
+# See the file 'COPYING' in the main Hamlib distribution directory for the
+# complete text of the GNU Public License version 2.
+#
+#############################################################################
 
 
 # Perl modules this script uses
 use warnings;
 use strict;
 use IO::Socket;
+use Getopt::Long;
+use Pod::Usage;
 
 # Global variables
 my $socket;
@@ -42,6 +50,12 @@ my $mode = "USB";
 my $bw = "2400";
 my %state = ();     # State of the rig--freq, mode, passband, ptt, etc.
 
+my $man = 0;
+my $help = 0;
+my $user_in;
+my $ret_val;
+my @cmd_str;
+
 # Error values returned from rigctld by Hamlib name
 my %errstr = (
     RIG_OK          => "0",     # No error, operation completed sucessfully
@@ -73,6 +87,12 @@ my %errval = reverse %errstr;
 #
 #############################################################################
 
+print "Welcome to tesctld.pl a program to test `rigctld'\n\n";
+print "Type '?' or 'help' for commands help.\n\n";
+
+# Parse command line options
+argv_opts();
+
 # Create the new socket.
 # 'localhost' may be replaced by any hostname or IP address where a
 # rigctld instance is running.
@@ -85,45 +105,197 @@ $socket = new IO::Socket::INET (PeerAddr    => $host,
     or die $@;
 
 
-# Query rigctld for the rig's frequency
-get_freq();
-print "The rig's frequency is: $state{Frequency}\n";
-print "\n";
+# Interactive loop
+do {
 
-# Do the same for the mode (reading the mode also returns the bandwidth)
-get_mode();
-print "The rig's mode is: $state{Mode}\n";
-print "The rig's passband is: $state{Passband}\n";
-print "\n";
+    print "rigctld command: ";
+    chomp($user_in = <>);
 
-# Setting the mode takes two parameters, mode and bandwidth
-print "Setting the rig's mode to $mode and bandwidth to $bw\n";
-print "\n";
-set_mode($mode, $bw);
+    # F, \set_freq
+    if ($user_in =~ /^F\s\d+\b$/ or $user_in =~ /^\\set_freq\s\d+\b$/) {
+        # Get the frequency value
+        @cmd_str = split(' ', $user_in);
+        $ret_val = set_freq($cmd_str[1]);
 
-get_mode();
-print "The rig's mode is now: $state{Mode}\n";
-print "The rig's passband is now: $state{Passband}\n";
-print "\n";
+        unless ($ret_val eq $errstr{"RIG_OK"}) {
+            errmsg ($ret_val);
+        }
+    }
 
-# Now set the rig's frequency
-print "Setting the rig's frequency to: $freq\n";
-set_freq($freq);
+    # f, \get_freq
+    elsif ($user_in =~ /^f\b$/ or $user_in =~ /^\\get_freq\b$/) {
+        # Query rig and process result
+        $ret_val = get_freq();
+
+        if ($ret_val eq $errstr{"RIG_OK"}) {
+            print "Frequency: $state{Frequency}\n\n";
+        } else {
+            errmsg ($ret_val);
+        }
+    }
+
+    # M, \set_mode
+    elsif ($user_in =~ /^M\s[A-Z]+\s\d+\b$/ or $user_in =~ /^\\set_mode\s[A-Z]+\s\d+\b$/) {
+        # Get the mode and passband value
+        @cmd_str = split(' ', $user_in);
+        $ret_val = set_mode($cmd_str[1], $cmd_str[2]);
+
+        unless ($ret_val eq $errstr{"RIG_OK"}) {
+            errmsg ($ret_val);
+        }
+    }
+
+    # m, \get_mode
+    elsif ($user_in =~ /^m\b$/ or $user_in =~ /^\\get_mode\b$/) {
+        # Do the same for the mode (reading the mode also returns the bandwidth)
+        $ret_val = get_mode();
+
+        if ($ret_val eq $errstr{"RIG_OK"}) {
+            print "Mode: $state{Mode}\n";
+            print "Passband: $state{Passband}\n\n";
+        } else {
+            errmsg ($ret_val);
+        }
+    }
+
+    # ?, help
+    elsif ($user_in =~ /^\?$/ or $user_in =~ /^help\b$/i) {
+        print <<EOF;
+
+Commands are entered in the same format as described in the rigctld(8)
+man page.  e.g. lower case letters call \\get commands and upper case
+letters call \\set commands or long command names may be used.
+
+Values passed to set commands are separated by a single space:
+
+F 28400000
+
+\\set_mode USB 2400
+
+See `man rigctld' for complete command descriptions.
+
+Type 'exit' or 'quit' to exit $0.
+
+EOF
+
+    }
+
+    else {
+        print "Unrecognized command.  Type '?' or 'help' for command help.\n"
+    }
+
+} while ($user_in !~ /^(exit|quit)\b$/i);
 
-get_freq();
-print "The rig's frequency is now: $state{Frequency}\n";
-print "\n";
 
 # Close the connection before we exit.
 close($socket);
 
 
 #############################################################################
-# Subroutines
+# Subroutines for interacting with rigctld
 #
 #############################################################################
 
 
+sub set_freq {
+    my $cmd;
+    my ($freq) = @_;
+
+    # N.B. Terminate query commands with a newline, e.g. "\n" character.
+    print $socket "\\set_freq $freq\n";
+
+    # rigctld echoes the command plus value(s) on "set" along with
+    # the Hamlib return value.
+    @answer = get_rigctl($socket);
+
+    # At this point the first line of @answer contains the command string echo
+    # and the last line contains the ending block marker and the Hamlib rig
+    # function return value.  No data lines are returned from a \\set_ command.
+
+    $cmd = shift @answer;
+
+    if ($cmd =~ /^set_freq:/) {
+        return get_errno(pop @answer);
+    } else {
+        # Oops!  Something went very wrong.
+        return $errstr{"RIG_EPROTO"};
+    }
+}
+
+
+sub get_freq {
+    my ($cmd, $errno);
+
+    print $socket "\\get_freq\n";
+
+    # Get the rig's frequency block from rigctld
+    @answer = get_rigctl($socket);
+
+    # Make sure we got the right response
+    $cmd = shift @answer;
+
+    if ($cmd =~ /^get_freq:/) {
+        $errno = get_errno(pop @answer);
+
+        # At this point the first line of @answer which is the command string echo
+        # and the last line which is the ending block marker and the Hamlib rig
+        # function return value have been removed from the array.  What is left
+        # over will be stored in the %state hash as a key: value pair.
+
+        if ($errno eq $errstr{"RIG_OK"}) {
+            get_state(@answer);
+        }
+        return $errno;
+    } else {
+        return $errstr{"RIG_EPROTO"};
+    }
+}
+
+
+sub set_mode {
+    my $cmd;
+    my ($mode, $bw) = @_;
+
+    # Setting the mode takes two values, mode and bandwidth.  All on the same line.
+    print $socket "\\set_mode $mode $bw\n";
+
+    @answer = get_rigctl($socket);
+    $cmd = shift @answer;
+
+    if ($cmd =~ /^set_mode:/) {
+        return get_errno(pop @answer);
+    } else {
+        return $errstr{"RIG_EPROTO"};
+    }
+}
+
+
+sub get_mode {
+    my ($cmd, $errno);
+
+    print $socket "\\get_mode\n";
+
+    @answer = get_rigctl($socket);
+    $cmd = shift @answer;
+
+    if ($cmd =~ /^get_mode:/) {
+        $errno = get_errno(pop @answer);
+
+        if ($errno eq $errstr{"RIG_OK"}) {
+            get_state(@answer);
+        }
+        return $errno;
+    } else {
+        return $errstr{"RIG_EPROTO"};
+    }
+}
+
+
+#############################################################################
+# testctld.pl helper functions
+#
+#############################################################################
+
 # Thanks to Uri Guttman on comp.lang.perl.misc for this function.
 # 'RPRT' is the token returned by rigctld to mark the end of the reply block.
 sub get_rigctl {
@@ -160,105 +332,74 @@ sub get_state {
 }
 
 
-sub get_freq {
-    my ($cmd, $errno);
+# Parse the command line for supported options.  Print help text as needed.
+sub argv_opts {
 
-    # N.B. Terminate query commands with a newline, e.g. "\n" character.
-    print $socket "\\get_freq\n";
+    # Parse options and print usage if there is a syntax error,
+    # or if usage was explicitly requested.
+    GetOptions('help|?'     => \$help,
+                man         => \$man,
+                "port=i"    => \$port,
+                "host=s"    => \$host
+            ) or pod2usage(2);
+    pod2usage(1) if $help;
+    pod2usage(-verbose => 2) if $man;
 
-    # Get the rig's frequency block from rigctld
-    @answer = get_rigctl($socket);
-
-    # Make sure we got the right response
-    $cmd = shift @answer;
-
-    if ($cmd =~ /^get_freq:/) {
-        $errno = get_errno(pop @answer);
-
-        # At this point the first line of @answer which is the command string echo
-        # and the last line which is the ending block marker and the Hamlib rig
-        # function return value have been removed from the array.  What is left
-        # over will be stored in the %state hash as a key: value pair.
-
-        if ($errno eq $errstr{"RIG_OK"}) {
-            get_state(@answer);
-        }
-        elsif ($errno lt $errstr{"RIG_OK"}) {
-            print "Hamlib returned $errval{$errno}\n";
-            close($socket);
-            exit (1);
-        }
-    }
 }
 
 
-sub get_mode {
-    my ($cmd, $errno);
+sub errmsg {
 
-    print $socket "\\get_mode\n";
-
-    @answer = get_rigctl($socket);
-    $cmd = shift @answer;
-
-    if ($cmd =~ /^get_mode:/) {
-        $errno = get_errno(pop @answer);
-
-        if ($errno eq $errstr{"RIG_OK"}) {
-            get_state(@answer);
-        }
-        elsif ($errno lt $errstr{"RIG_OK"}) {
-            print "Hamlib returned $errval{$errno}\n";
-            close($socket);
-            exit (1);
-        }
-    }
-}
-
-sub set_freq {
-    my ($cmd, $errno);
-    my ($freq) = @_;
-
-    print $socket "\\set_freq $freq\n";
-
-    # rigctld echoes the command plus value(s) on "set" along with
-    # the Hamlib return value.
-    @answer = get_rigctl($socket);
-    $cmd = shift @answer;
-
-    if ($cmd =~ /^set_freq:/) {
-        $errno = get_errno(pop @answer);
-
-        # As $cmd contains a copy of the line printed to $socket as returned
-        # by rigctld, it can be split and the value(s) following the command
-        # tested to see that it matches the passed in value, etc.
-
-        if ($errno lt $errstr{"RIG_OK"}) {
-            print "Hamlib returned $errval{$errno}\n";
-            close($socket);
-            exit (1);
-        }
-    }
+    print "Hamlib returned $errval{$_[0]}\n\n";
 }
 
 
-sub set_mode {
-    my ($cmd, $errno);
-    my ($mode, $bw) = @_;
+# POD for pod2usage
 
-    # Setting the mode takes two values, mode and bandwidth.  All on the same line.
-    print $socket "\\set_mode $mode $bw\n";
+__END__
 
-    @answer = get_rigctl($socket);
-    $cmd = shift @answer;
+=head1 NAME
 
-    if ($cmd =~ /^set_mode:/) {
-        $errno = get_errno(pop @answer);
+testctld.pl - A test and example program for `rigctld' written in Perl.
 
-        if ($errno lt $errstr{"RIG_OK"}) {
-            print "Hamlib returned $errval{$errno}\n";
-            close($socket);
-            exit (1);
-        }
-    }
-}
+=head1 SYNOPSIS
 
+testctld.pl [options]
+
+ Options:
+    --host          Hostname or IP address of target `rigctld' process
+    --port          TCP Port of target `rigctld' process
+    --help          Brief help message
+    --man           Full documentation
+
+=head1 DESCRIPTION
+
+B<testcld.pl> provides a set of functions to interactively test the Hamlib
+`rigctld' TCP/IP network daemon.  It also aims to be an example of programming
+code to control a radio via TCP/IP in Hamlib.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--host>
+
+Hostname or IP address of the target `rigctld' process.  Default is 'localhost'
+which should resolve to 127.0.0.1 if I</etc/hosts> is configured correctly.
+
+=item B<--port>
+
+TCP port of the target `rigctld' process.  Default is 4532.  Mutliple instances
+of `rigctld' will require unique port numbers.
+
+=item B<--help>
+
+Prints a brief help message and exits.
+
+=item B<--man>
+
+Prints this manual page and exits.
+
+=back
+
+=cut