kopia lustrzana https://github.com/Hamlib/Hamlib
Upload correct version this time...
git-svn-id: https://hamlib.svn.sourceforge.net/svnroot/hamlib/trunk@2814 7ae35d74-ebe9-4afe-98af-79ac388436b8Hamlib-1.2.11
Nate Bargmann, N0NB
rodzic
52a87d096c
commit
af20dcae80
|
|
@ -1,13 +1,16 @@
|
|||
#! /usr/bin/perl
|
||||
|
||||
# testctld.pl - (C) Nate Bargmann 2008
|
||||
# testctld.pl - (C) 2008,2010 Nate Bargmann, n0nb@arrl.net
|
||||
# A Perl test script for the rigctld program.
|
||||
|
||||
# $Id$
|
||||
|
||||
# It connects to the rigctld TCP port (default 4532) and queries
|
||||
# the daemon for some common rig information. It also aims to provide
|
||||
# a bit of example code for Perl scripting.
|
||||
# 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 program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
|
|
@ -27,129 +30,235 @@
|
|||
# Perl modules this script uses
|
||||
use warnings;
|
||||
use strict;
|
||||
use IO::Socket::INET;
|
||||
use IO::Socket;
|
||||
|
||||
|
||||
# Local variables
|
||||
# Global variables
|
||||
my $socket;
|
||||
my $host = 'localhost';
|
||||
my $port = 4532;
|
||||
my @answer;
|
||||
my $get_freq;
|
||||
my $get_mode;
|
||||
my $get_bw;
|
||||
my $flags;
|
||||
# values to set rig
|
||||
my $set_freq = "14250000";
|
||||
my $set_mode = "USB";
|
||||
my $set_bw = "2400";
|
||||
my $freq = "14250000";
|
||||
my $mode = "USB";
|
||||
my $bw = "2400";
|
||||
my %state = (); # State of the rig--freq, mode, passband, ptt, etc.
|
||||
|
||||
# Error values returned from rigctld by Hamlib name
|
||||
my %errstr = (
|
||||
RIG_OK => "0", # No error, operation completed sucessfully
|
||||
RIG_EINVAL => "-1", # invalid parameter
|
||||
RIG_ECONF => "-2", # invalid configuration (serial,..)
|
||||
RIG_ENOMEM => "-3", # memory shortage
|
||||
RIG_ENIMPL => "-4", # function not implemented, but will be
|
||||
RIG_ETIMEOUT => "-5", # communication timed out
|
||||
RIG_EIO => "-6", # IO error, including open failed
|
||||
RIG_EINTERNAL => "-7", # Internal Hamlib error, huh?!
|
||||
RIG_EPROTO => "-8", # Protocol error
|
||||
RIG_ERJCTED => "-9", # Command rejected by the rig
|
||||
RIG_ETRUNC => "-10", # Command performed, but arg truncated
|
||||
RIG_ENAVAIL => "-11", # function not available
|
||||
RIG_ENTARGET => "-12", # VFO not targetable
|
||||
RIG_BUSERROR => "-13", # Error talking on the bus
|
||||
RIG_BUSBUSY => "-14", # Collision on the bus
|
||||
RIG_EARG => "-15", # NULL RIG handle or any invalid pointer parameter in get arg
|
||||
RIG_EVFO => "-16", # Invalid VFO
|
||||
RIG_EDOM => "-17", # Argument out of domain of func
|
||||
);
|
||||
|
||||
# Error values returned from rigctld by Hamlib value
|
||||
my %errval = reverse %errstr;
|
||||
|
||||
|
||||
# Thanks to Uri Guttman on comp.lang.perl.misc for this function
|
||||
sub get_results {
|
||||
|
||||
my ($sock) = @_;
|
||||
my @lines;
|
||||
my $errno;
|
||||
my $line;
|
||||
# my $x;
|
||||
|
||||
do {
|
||||
while ( !($line = $sock->getline)) { ;}
|
||||
print $line;
|
||||
|
||||
# return @lines if $line =~ /^RPRT\s+0$/;
|
||||
if ($line) {
|
||||
print $line;
|
||||
push @lines, $line;
|
||||
}
|
||||
# else {
|
||||
# return @lines;
|
||||
# }
|
||||
#if ($line =~ /^RPRT.*$/) {
|
||||
#print $line;
|
||||
#$errno = (split $line)[1];
|
||||
#print $errno;
|
||||
#unless ($errno) {
|
||||
#return @lines;
|
||||
#}
|
||||
#else {
|
||||
#return $errno * -1;
|
||||
#}
|
||||
#}
|
||||
#else {
|
||||
#push @lines, $line;
|
||||
#}
|
||||
} until ($line ne "");
|
||||
return @lines;
|
||||
}
|
||||
#############################################################################
|
||||
# Main program
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
# Create the new socket.
|
||||
# 'localhost' may be replaced by any hostname or IP address where a
|
||||
# rigctld instance is running.
|
||||
# Timeout is set to 5 seconds.
|
||||
$socket = IO::Socket::INET->new(PeerAddr => 'localhost',
|
||||
PeerPort => 4532,
|
||||
$socket = new IO::Socket::INET (PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Proto => 'tcp',
|
||||
Type => SOCK_STREAM,
|
||||
Timeout => 5,
|
||||
Blocking => 0 )
|
||||
Timeout => 5 )
|
||||
or die $@;
|
||||
|
||||
|
||||
# Query rigctld for the rig's frequency
|
||||
# N.B. Terminate query commands with a newline, e.g. "\n" character.
|
||||
print $socket "f\n";
|
||||
|
||||
# Get the rig's frequency from rigctld and print it to STDOUT
|
||||
# N.B. Replies are newline terminated, so lines in @answer end with '\n'.
|
||||
@answer = get_results($socket);
|
||||
#$get_freq = <$socket>;
|
||||
#$get_freq = $socket->getline;
|
||||
#chomp($get_freq);
|
||||
|
||||
print "The rig's frequency is: $answer[0]";
|
||||
#print "The rig's frequency is: $get_freq\n";
|
||||
|
||||
# Extra newline for screen formatting.
|
||||
get_freq();
|
||||
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 $socket "m\n";
|
||||
@answer = get_results($socket);
|
||||
#$get_mode = <$socket>;
|
||||
#chomp($get_mode);
|
||||
#$get_bw = <$socket>;
|
||||
#chomp($get_bw);
|
||||
get_mode();
|
||||
print "The rig's mode is: $state{Mode}\n";
|
||||
print "The rig's passband is: $state{Passband}\n";
|
||||
print "\n";
|
||||
|
||||
#print "The rig's mode is: $get_mode\n";
|
||||
#print "The rig's bandwidth is: $get_bw\n";
|
||||
print "The rig's mode is: $answer[0]";
|
||||
print "The rig's bandwidth is: $answer[1]";
|
||||
# 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);
|
||||
|
||||
get_mode();
|
||||
print "The rig's mode is now: $state{Mode}\n";
|
||||
print "The rig's passband is now: $state{Passband}\n";
|
||||
print "\n";
|
||||
|
||||
# Now set the rig's frequency
|
||||
#print "Setting the rig's frequency to: $set_freq\n";
|
||||
#print $socket "F $set_freq\n";
|
||||
#<$socket>;
|
||||
#print $socket "f\n";
|
||||
#@answer = get_results($socket);
|
||||
#$get_freq = <$socket>;
|
||||
#chomp($get_freq);
|
||||
#print "The rig's frequency is now: $get_freq\n";
|
||||
#print "\n";
|
||||
print "Setting the rig's frequency to: $freq\n";
|
||||
set_freq($freq);
|
||||
|
||||
# Setting the mode takes two parameters, mode and bandwidth
|
||||
#print "Setting the rig's mode to $set_mode and bandwidth to $set_bw\n";
|
||||
#print $socket "\\set_mode $set_mode $set_bw\n";
|
||||
#<$socket>;
|
||||
#print $socket "\\get_mode\n";
|
||||
#@answer = get_results($socket);
|
||||
#$get_mode = <$socket>;
|
||||
#chomp($get_mode);
|
||||
#$get_bw = <$socket>;
|
||||
#chomp($get_bw);
|
||||
#print "The rig's mode is now: $get_mode\n";
|
||||
#print "The rig's bandwidth is now: $get_bw\n";
|
||||
#print "\n";
|
||||
get_freq();
|
||||
print "The rig's frequency is now: $state{Frequency}\n";
|
||||
print "\n";
|
||||
|
||||
# Close the connection before we exit.
|
||||
close($socket);
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Subroutines
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
|
||||
# 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 {
|
||||
my ($sock) = @_;
|
||||
my @lines;
|
||||
|
||||
while (my $line = <$sock>) {
|
||||
# rigctld terminates each line with '\n'
|
||||
chomp $line;
|
||||
push @lines, $line;
|
||||
return @lines if $line =~ /^RPRT/;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Extract the Hamlib error value returned with the last line from rigctld
|
||||
sub get_errno {
|
||||
|
||||
chomp @_;
|
||||
my @errno = split(/ /, $_[0]);
|
||||
|
||||
return $errno[1];
|
||||
}
|
||||
|
||||
|
||||
# Builds the %state hash from the lines returned by rigctld which are of the
|
||||
# form "Frequency: 14250000"
|
||||
sub get_state {
|
||||
|
||||
foreach my $line (@_) {
|
||||
(my $key, my $val) = split(/: /, $line);
|
||||
$state{$key} = $val;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub get_freq {
|
||||
my ($cmd, $errno);
|
||||
|
||||
# N.B. Terminate query commands with a newline, e.g. "\n" character.
|
||||
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);
|
||||
}
|
||||
elsif ($errno lt $errstr{"RIG_OK"}) {
|
||||
print "Hamlib returned $errval{$errno}\n";
|
||||
close($socket);
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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);
|
||||
}
|
||||
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 {
|
||||
my ($cmd, $errno);
|
||||
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:/) {
|
||||
$errno = get_errno(pop @answer);
|
||||
|
||||
if ($errno lt $errstr{"RIG_OK"}) {
|
||||
print "Hamlib returned $errval{$errno}\n";
|
||||
close($socket);
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Ładowanie…
Reference in New Issue