2010-02-14 22:18:00 +00:00
|
|
|
#! /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
|
2016-01-12 21:53:53 +00:00
|
|
|
# response mode. See the rotctld(1) man page for details.
|
2010-02-14 22:18:00 +00:00
|
|
|
|
|
|
|
#############################################################################
|
2011-08-22 01:51:06 +00:00
|
|
|
# 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.
|
2010-02-14 22:18:00 +00:00
|
|
|
#
|
2011-08-22 01:51:06 +00:00
|
|
|
# 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.
|
2010-02-14 22:18:00 +00:00
|
|
|
#
|
2011-08-22 01:51:06 +00:00
|
|
|
# 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.
|
2010-02-14 22:18:00 +00:00
|
|
|
#
|
|
|
|
# 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 = (
|
2012-08-22 02:54:50 +00:00
|
|
|
RIG_OK => "0", # No error, operation completed successfully
|
2010-02-14 22:18:00 +00:00
|
|
|
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;
|
|
|
|
|
2016-01-12 21:53:53 +00:00
|
|
|
Commands are entered in the same format as described in the rotctld(1)
|
2010-02-14 22:18:00 +00:00
|
|
|
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. Mutliple 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
|
|
|
|
|
2016-01-12 21:53:53 +00:00
|
|
|
Commands are the same as described in the rotctld(1) man page. This is only
|
2010-02-14 22:18:00 +00:00
|
|
|
a brief summary.
|
|
|
|
|
2010-02-15 01:37:39 +00:00
|
|
|
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
|
2010-02-14 22:18:00 +00:00
|
|
|
|
|
|
|
=cut
|