kopia lustrzana https://github.com/Hamlib/Hamlib
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-79ac388436b8Hamlib-1.2.11
Nate Bargmann, N0NB
rodzic
ef4fea6522
commit
f698692e83
|
|
@ -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
|
||||
|
|
|
|||
Ładowanie…
Reference in New Issue