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

369
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";
print "rigctld command: ";
chomp($user_in = <>);
# 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]);
unless ($ret_val eq $errstr{"RIG_OK"}) {
errmsg ($ret_val);
}
}
# 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) # Do the same for the mode (reading the mode also returns the bandwidth)
get_mode(); $ret_val = get_mode();
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 if ($ret_val eq $errstr{"RIG_OK"}) {
print "Setting the rig's mode to $mode and bandwidth to $bw\n"; print "Mode: $state{Mode}\n";
print "\n"; print "Passband: $state{Passband}\n\n";
set_mode($mode, $bw); } else {
errmsg ($ret_val);
}
}
get_mode(); # ?, help
print "The rig's mode is now: $state{Mode}\n"; elsif ($user_in =~ /^\?$/ or $user_in =~ /^help\b$/i) {
print "The rig's passband is now: $state{Passband}\n"; print <<EOF;
print "\n";
# Now set the rig's frequency Commands are entered in the same format as described in the rigctld(8)
print "Setting the rig's frequency to: $freq\n"; man page. e.g. lower case letters call \\get commands and upper case
set_freq($freq); 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