mirror
/
Hamlib
kopia lustrzana https://github.com/Hamlib/Hamlib
1
0
Forkuj 0
Kod Zgłoszenia Projekty Wydania Wiki Aktywność

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
Hamlib-1.2.11
Nate Bargmann, N0NB 2010-01-28 12:26:45 +00:00
rodzic ef4fea6522
commit f698692e83
1 zmienionych plików z 256 dodań i 115 usunięć
Pokaż statystyki Ściągnij plik aktualizacji Ściągnij plik porównania Expand all files Collapse all files

371
tests/testctld.pl
Wyświetl plik

@ -8,10 +8,11 @@
# It connects to the rigctld TCP port (default 4532) and queries the daemon # 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 # for some common rig information and sets some values. It also aims to
# provide a bit of example code for Perl scripting. # 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 # This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License # modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2 # 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 # You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software # along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # 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 # Perl modules this script uses
use warnings; use warnings;
use strict; use strict;
use IO::Socket; use IO::Socket;
use Getopt::Long;
use Pod::Usage;
# Global variables # Global variables
my $socket; my $socket;
@ -42,6 +50,12 @@ my $mode = "USB";
my $bw = "2400"; my $bw = "2400";
my %state = (); # State of the rig--freq, mode, passband, ptt, etc. 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 # Error values returned from rigctld by Hamlib name
my %errstr = ( my %errstr = (
RIG_OK => "0", # No error, operation completed sucessfully 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. # Create the new socket.
# 'localhost' may be replaced by any hostname or IP address where a # 'localhost' may be replaced by any hostname or IP address where a
# rigctld instance is running. # rigctld instance is running.
@ -85,45 +105,197 @@ $socket = new IO::Socket::INET (PeerAddr => $host,
or die $@; or die $@;
# Query rigctld for the rig's frequency # Interactive loop
get_freq(); do {
print "The rig's frequency is: $state{Frequency}\n";
print "\n";
# Do the same for the mode (reading the mode also returns the bandwidth) print "rigctld command: ";
get_mode(); chomp($user_in = <>);
print "The rig's mode is: $state{Mode}\n";
print "The rig's passband is: $state{Passband}\n";
print "\n";
# Setting the mode takes two parameters, mode and bandwidth # F, \set_freq
print "Setting the rig's mode to $mode and bandwidth to $bw\n"; if ($user_in =~ /^F\s\d+\b$/ or $user_in =~ /^\\set_freq\s\d+\b$/) {
print "\n"; # Get the frequency value
set_mode($mode, $bw); @cmd_str = split(' ', $user_in);
$ret_val = set_freq($cmd_str[1]);
get_mode(); unless ($ret_val eq $errstr{"RIG_OK"}) {
print "The rig's mode is now: $state{Mode}\n"; errmsg ($ret_val);
print "The rig's passband is now: $state{Passband}\n"; }
print "\n"; }
# Now set the rig's frequency # f, \get_freq
print "Setting the rig's frequency to: $freq\n"; elsif ($user_in =~ /^f\b$/ or $user_in =~ /^\\get_freq\b$/) {
set_freq($freq); # 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 the connection before we exit.
close($socket); 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. # 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. # 'RPRT' is the token returned by rigctld to mark the end of the reply block.
sub get_rigctl { sub get_rigctl {
@ -160,105 +332,74 @@ sub get_state {
} }
sub get_freq { # Parse the command line for supported options. Print help text as needed.
my ($cmd, $errno); sub argv_opts {
# N.B. Terminate query commands with a newline, e.g. "\n" character. # Parse options and print usage if there is a syntax error,
print $socket "\\get_freq\n"; # 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 { sub errmsg {
my ($cmd, $errno);
print $socket "\\get_mode\n"; print "Hamlib returned $errval{$_[0]}\n\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);
}
}
} }
sub set_mode { # POD for pod2usage
my ($cmd, $errno);
my ($mode, $bw) = @_;
# Setting the mode takes two values, mode and bandwidth. All on the same line. __END__
print $socket "\\set_mode $mode $bw\n";
@answer = get_rigctl($socket); =head1 NAME
$cmd = shift @answer;
if ($cmd =~ /^set_mode:/) { testctld.pl - A test and example program for `rigctld' written in Perl.
$errno = get_errno(pop @answer);
if ($errno lt $errstr{"RIG_OK"}) { =head1 SYNOPSIS
print "Hamlib returned $errval{$errno}\n";
close($socket);
exit (1);
}
}
}
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