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

677 wiersze
20 KiB
Perl
Executable File
Czysty Bezpośredni odnośnik Wina Historia

#! /usr/bin/perl
# testrotctld.pl - (C) 2008,2010 Nate Bargmann, n0nb@arrl.net
# A Perl test script for the rotctld program.
#
#
# It connects to the rotctld TCP port (default 4533) and queries the daemon
# for some common rot information and sets some values. It also aims to
# provide a bit of example code for Perl scripting.
#
# This program utilizes the Extended Response protocol of rotctld in line
# response mode. See the rotctld(1) man page for details.
#############################################################################
# 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 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# 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.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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;
my $host = 'localhost';
my $port = 4533;
my %rot_state = (); # State of the rotor--position, etc.
my %rot_caps = (); # Rotor capabilities from \dump_caps
my $man = 0;
my $help = 0;
my $debug = 0;
my $user_in;
my $ret_val;
# Error values returned from rotctld by Hamlib name
my %errstr = (
RIG_OK => "0", # No error, operation completed successfully
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 rot
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
# testctld specific error values from -100 onward
CTLD_OK => "-100", # testrotctld -- No error
CTLD_ENIMPL => "-103", # testrotctld -- %rot_caps reports backend function not implemented
CTLD_EPROTO => "-108", # testrotctld -- Echoed command mismatch or other error
);
# Error values returned from rotctld by Hamlib value
my %errval = reverse %errstr;
# Rotor '\move' command token values
my %direct = (
UP => '2',
DOWN => '4',
LEFT => '8',
CCW => '8', # Synonym for LEFT
RIGHT => '16',
CW => '16', # Synonym for RIGHT
);
#############################################################################
# Main program
#
#############################################################################
# Parse command line options
argv_opts();
# Create the new socket.
# 'localhost' may be replaced by any hostname or IP address where a
# rotctld instance is running.
# Timeout is set to 5 seconds.
$socket = new IO::Socket::INET (PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp',
Type => SOCK_STREAM,
Timeout => 5 )
or die $@;
print "Welcome to testrotctld.pl a program to test 'rotctld'\n";
print "Type '?' or 'help' for commands help.\n\n";
# Populate %rot_caps from \dump_caps
$ret_val = dump_caps();
# Tell user what rotor rotctld is working with
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Hamlib Model: " . $rot_caps{'Caps dump for model'} . "\t";
print "Common Name: " . $rot_caps{'Mfg name'} . ' ' . $rot_caps{'Model name'} . "\n\n\n";
} else {
errmsg ($ret_val);
}
# Interactive loop
do {
print "rotctld command: ";
chomp($user_in = <>);
# P, \set_pos
if ($user_in =~ /^(P|\\set_pos)\s+([-+]?([0-9]*\.)?[0-9]+)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
if ($rot_caps{'Can set Position'} eq 'Y') {
# Get the entered az and el values
print "Az = $2, El = $4\n" if $debug;
$ret_val = rot_cmd('set_pos', $2, $4);
unless ($ret_val eq $errstr{'RIG_OK'}) {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# p, \get_pos
elsif ($user_in =~ /^(p|\\get_pos)\b$/) {
if ($rot_caps{'Can get Position'} eq 'Y') {
# Query rot and process result
$ret_val = rot_cmd('get_pos');
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Azimuth: " . $rot_state{Azimuth} . "\n";
print "Elevation: " . $rot_state{Elevation} . "\n\n";
} else {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# M, \move
elsif ($user_in =~ /^(M|\\move)\s+([A-Z]+)\s+(\d+)\b$/) {
if ($rot_caps{'Can Move'} eq 'Y') {
# Get the entered mode and passband values
print "Move = $direct{$2}, Speed = $3\n" if $debug;
$ret_val = rot_cmd('move', $direct{$2}, $3);
unless ($ret_val eq $errstr{'RIG_OK'}) {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# S, \stop
elsif ($user_in =~ /^(S|\\stop)\b$/) {
if ($rot_caps{'Can Stop'} eq 'Y') {
print "Stop\n" if $debug;
$ret_val = rot_cmd('stop'); # $vfo not used!
unless ($ret_val eq $errstr{'RIG_OK'}) {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# K, \park
elsif ($user_in =~ /^(K|\\park)\b$/) {
if ($rot_caps{'Can Park'} eq 'Y') {
print "Park\n" if $debug;
$ret_val = rot_cmd('park');
unless ($ret_val eq $errstr{'RIG_OK'}) {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# R, \reset
elsif ($user_in =~ /^(R|\\reset)\s+(\d)\b$/) {
if ($rot_caps{'Can Reset'} eq 'Y') {
print "Reset\n" if $debug;
$ret_val = rot_cmd('reset', $2);
unless ($ret_val eq $errstr{'RIG_OK'}) {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# _, \get_info
elsif ($user_in =~ /^(_|\\get_info)\b$/) {
if ($rot_caps{'Can get Info'} eq 'Y') {
print "Get info\n" if $debug;
$ret_val = rot_cmd('get_info');
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Info: " . $rot_state{Info} . "\n\n";
} else {
errmsg ($ret_val);
}
} else {
errmsg($errstr{'CTLD_ENIMPL'});
}
}
# L, \lonlat2loc
elsif ($user_in =~ /^(L|\\lonlat2loc)\s+([-+]?([0-9]*\.)?[0-9]+)\s+([-+]?([0-9]*\.)?[0-9]+)\s+(\d+)\b$/) {
print "Longitude = $2, Latitude = $4, Length = $6\n" if $debug;
$ret_val = rot_cmd('lonlat2loc', $2, $4, $6);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Locator: " . $rot_state{Locator} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# l, \loc2lonlat
elsif ($user_in =~ /^(l|\\loc2lonlat)\s+([A-Za-z0-9]+)\b$/) {
print "Locator = $2\n" if $debug;
$ret_val = rot_cmd('loc2lonlat', $2);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Longitude: " . $rot_state{Longitude} . "\n";
print "Latitude: " . $rot_state{Latitude} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# D, \dms2dec
elsif ($user_in =~ /^(D|\\dms2dec)\s+[+-]?(\d+)\s+(\d+)\s+(([0-9]*\.)?[0-9]+)\s+(\d)\b$/) {
print "Degrees = $2, Minutes = $3, Seconds = $4, S/W = $6\n" if $debug;
$ret_val = rot_cmd('dms2dec', $2, $3, $4, $6);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Decimal Degrees: " . $rot_state{'Dec Degrees'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# d, \dec2dms
elsif ($user_in =~ /^(d|\\dec2dms)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
print "Decimal Degrees = $2\n" if $debug;
$ret_val = rot_cmd('dec2dms', $2);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Degrees: " . $rot_state{Degrees} . "\n";
print "Minutes: " . $rot_state{Minutes} . "\n";
print "Seconds: " . $rot_state{Seconds} . "\n";
print "South/West: " . $rot_state{'S/W'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# E, \dmmm2dec
elsif ($user_in =~ /^(E|\\dmmm2dec)\s+[+-]?(\d+)\s+(([0-9]*\.)?[0-9]+)\s+(\d)\b$/) {
print "Degrees = $2, Minutes = $3, S/W = $5\n" if $debug;
$ret_val = rot_cmd('dmmm2dec', $2, $3, $5);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Decimal Degrees: " . $rot_state{'Dec Deg'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# e, \dec2dmmm
elsif ($user_in =~ /^(e|\\dec2dmmm)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
print "Decimal Degrees = $2\n" if $debug;
$ret_val = rot_cmd('dec2dmmm', $2);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Degrees: " . $rot_state{Degrees} . "\n";
print "Decimal Minutes: " . $rot_state{'Dec Minutes'} . "\n";
print "South/West: " . $rot_state{'S/W'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# B, \qrb
elsif ($user_in =~ /^(B|\\qrb)\s+([-+]?([0-9]*\.)?[0-9]+)\s+([-+]?([0-9]*\.)?[0-9]+)\s+([-+]?([0-9]*\.)?[0-9]+)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
print "Lon 1 = $2, Lat 1 = $4, Lon 2 = $6, Lat 2 = $8\n" if $debug;
$ret_val = rot_cmd('qrb', $2, $4, $6, $8);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Distance (km): " . $rot_state{'QRB Distance'} . "\n";
print "Azimuth (Deg): " . $rot_state{'QRB Azimuth'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# A, \a_sp2a_lp
elsif ($user_in =~ /^(A|\\a_sp2a_lp)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
print "Short Path Degrees = $2\n" if $debug;
$ret_val = rot_cmd('a_sp2a_lp', $2);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Long Path Degrees: " . $rot_state{'Long Path Deg'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# a, \d_sp2d_lp
elsif ($user_in =~ /^(a|\\d_sp2d_lp)\s+([-+]?([0-9]*\.)?[0-9]+)\b$/) {
print "Short Path km = $2\n" if $debug;
$ret_val = rot_cmd('d_sp2d_lp', $2);
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Long Path km: " . $rot_state{'Long Path km'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# 1, \dump_caps
elsif ($user_in =~ /^(1|\\dump_caps)\b$/) {
$ret_val = dump_caps();
if ($ret_val eq $errstr{'RIG_OK'}) {
print "Model: " . $rot_caps{'Caps dump for model'} . "\n";
print "Manufacturer: " . $rot_caps{'Mfg name'} . "\n";
print "Name: " . $rot_caps{'Model name'} . "\n\n";
} else {
errmsg ($ret_val);
}
}
# ?, help
elsif ($user_in =~ /^\?|^help\b$/) {
print <<EOF;
Commands are entered in the same format as described in the rotctld(1)
man page. e.g. generally lower case letters call \\get commands and upper
case letters call \\set commands or long command names may be used. An
exception are the locator commands where paired conversions are arbitrarily
assigned upper and lower case commands.
Values passed to set commands are separated by a single space:
P 150.75 22.5
\\get_pos
See 'man rotctld' for complete command descriptions.
Type 'q' or 'exit' to exit $0.
EOF
}
elsif ($user_in !~ /^(exit|q)\b$/i) {
print "Unrecognized command. Type '?' or 'help' for command help.\n"
}
} while ($user_in !~ /^(exit|q)\b$/i);
# Close the connection before we exit.
close($socket);
#############################################################################
# Subroutines for interacting with rotctld
#
#############################################################################
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# rot_cmd -- Build command string, check returned data, and populate %rot_state
#
# Passed parameters:
# $cmd = rotctld command
# $p1 - $p4 = \set command parameters
#
# Returns error value from rotctld or local error value if echoed command mismatch
#
sub rot_cmd {
my ($errno, @answer);
my $cmd = shift @_;
my $p1 = shift @_;
my $p2 = shift @_;
my $p3 = shift @_;
my $p4 = shift @_;
# Add a space to the beginning of the $p? arguments
if (defined $p1) {
# "Stringify" parameter value then add a space to the beginning of the string
$p1 .= '';
$p1 = sprintf("%*s", 1 + length $p1, $p1);
} else { $p1 = ''; }
if (defined $p2) {
$p2 .= '';
$p2 = sprintf("%*s", 1 + length $p2, $p2);
} else { $p2 = ''; }
if (defined $p3) {
$p3 .= '';
$p3 = sprintf("%*s", 1 + length $p3, $p3);
} else { $p3 = ''; }
if (defined $p4) {
$p4 .= '';
$p4 = sprintf("%*s", 1 + length $p4, $p4);
} else { $p4 = ''; }
print 'Command: +\\' . $cmd . $p1 . $p2 . $p3 . $p4 . "\n\n" if $debug;
# N.B. Terminate query commands with a newline, e.g. "\n" character.
# N.B. Preceding '+' char to request block or extended response protocol
print $socket '+\\' . $cmd . $p1 . $p2 . $p3 . $p4 . "\n";
# rotctld echoes the command plus value(s) on "get" along with
# separate lines for the queried value(s) and the Hamlib return value.
@answer = get_rotctl($socket);
if ((shift @answer) =~ /^$cmd:/) {
$errno = get_errno(pop @answer);
if ($errno eq $errstr{'RIG_OK'}) {
# 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 rot
# 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 for each
# returned line.
if (@answer) { get_state(@answer) } # Empty array on \set commands
}
return $errno;
} else {
return $errstr{'CTLD_EPROTO'};
}
}
# Get the rot capabilities from Hamlib and store in the %rot_caps hash.
sub dump_caps {
my ($cmd, $errno, @answer);
print $socket "+\\dump_caps\n";
@answer = get_rotctl($socket);
$cmd = shift @answer;
if ($cmd =~ /^dump_caps:/) {
$errno = get_errno(pop @answer);
if ($errno eq $errstr{'RIG_OK'}) {
get_caps(@answer);
}
return $errno;
} else {
return $errstr{'RIG_EPROTO'};
}
}
#############################################################################
# testrotctld.pl helper functions
#
#############################################################################
# Thanks to Uri Guttman on comp.lang.perl.misc for this function.
# 'RPRT' is the token returned by rotctld to mark the end of the reply block.
sub get_rotctl {
my $sock = shift @_;
my @lines;
while (<$sock>) {
# rotctld terminates each line with '\n'
chomp;
push @lines, $_;
return @lines if $_ =~ /^RPRT/;
}
}
# Builds the %rot_state hash from the lines returned by rotctld which are of the
# form "Azimuth: 90.000000, elevation: 45.000000", etc.
sub get_state {
my ($key, $val);
foreach (@_) {
($key, $val) = split(/: /, $_);
$rot_state{$key} = $val;
}
}
# Parse the (large) \dump_caps command response into %rot_caps.
# TODO: process all lines of output
sub get_caps {
my ($key, $val);
foreach (@_) {
if (($_ =~ /^Caps .*:/) or
($_ =~ /^Model .*:/) or
($_ =~ /^Mfg .*:/) or
($_ =~ /^Can .*:/)
) {
($key, $val) = split(/:\s+/, $_);
$rot_caps{$key} = $val;
}
}
}
# Extract the Hamlib error value returned with the last line from rotctld
sub get_errno {
chomp @_;
my @errno = split(/ /, $_[0]);
return $errno[1];
}
# FIXME: Better argument handling
sub errmsg {
unless (($_[0] eq $errstr{'CTLD_EPROTO'}) or ($_[0] eq $errstr{'CTLD_ENIMPL'})) {
print "rotctld returned Hamlib $errval{$_[0]}\n\n";
}
elsif ($_[0] eq $errstr{'CTLD_EPROTO'}) {
print "Echoed command mismatch\n\n";
}
elsif ($_[0] eq $errstr{'CTLD_ENIMPL'}) {
print "Function not yet implemented in Hamlib rot backend\n\n";
}
}
# Parse the command line for supported options. Print help text as needed.
sub argv_opts {
# 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,
debug => \$debug
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;
}
# POD for pod2usage
__END__
=head1 NAME
testctld.pl - A test and example program for 'rotctld' written in Perl.
=head1 SYNOPSIS
testctld.pl [options]
Options:
--host Hostname or IP address of target 'rotctld' process
--port TCP Port of target 'rotctld' process
--help Brief help message
--man Full documentation
--debug Enable debugging output
=head1 DESCRIPTION
B<testcld.pl> provides a set of functions to interactively test the Hamlib
I<rotctld> TCP/IP network daemon. It also aims to be an example of programming
code to control a rotor via TCP/IP in Hamlib.
=head1 OPTIONS
=over 8
=item B<--host>
Hostname or IP address of the target I<rotctld> process. Default is I<localhost>
which should resolve to 127.0.0.1 if I</etc/hosts> is configured correctly.
=item B<--port>
TCP port of the target I<rotctld> process. Default is 4533. Multiple instances
of I<rotctld> will require unique port numbers.
=item B<--help>
Prints a brief help message and exits.
=item B<--man>
Prints this manual page and exits.
=item B<--debug>
Enables debugging output to the console.
=back
=head1 COMMANDS
Commands are the same as described in the rotctld(1) man page. This is only
a brief summary.
P, \set_pos Set the rotor's Azimuth and Elevation
p, \get_pos Get the rotor's Azimuth and Elevation
M. \move Move Up, Down, Left, Right at Speed
S, \stop Stop rotation
K, \park Set the rotor to the park position
R, \reset Reset the rotor
_, \get_info Get the rotor Model Name
1, \dump_caps Get the rot capabilities and display select values
These commands are for the locator support API.
L, \lonlat2loc Convert Longitude and Latitude to Maidenhead square
l, \loc2lonlat Convert Maidenhead square to Longitude and Latitude
D, \dms2dec Convert Degrees, Minutes, Seconds to Decimal Degrees
d, \dec2dms Convert Decimal Degrees to Degrees, Minutes, Seconds
E, \dmmm2dec Convert Degrees, Decimal Minutes to Decimal Degrees
e, \dec2dmmm Convert Decimal Degrees to Degrees, Decimal Minutes
B, \qrb Compute distance and azimuth between Lon 1, Lat 1,
and Lon 2, Lat 2
A, \a_sp2a_lp Compute Long Path Azimuth from Short Path Azimuth
a, \d_sp2d_lp Compute Long Path Distance from Short Path Distance
=cut
Reference in New Issue View Git Blame Kopiuj bezpośredni odnośnik