| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | #! /usr/bin/perl | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | # testctld.pl - (C) 2008,2010 Nate Bargmann, n0nb@arrl.net | 
					
						
							| 
									
										
										
										
											2008-01-07 21:41:27 +00:00
										 |  |  | # A Perl test script for the rigctld program. | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | # | 
					
						
							|  |  |  | # | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | # 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. | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | # This program utilizes the Extended Response protocol of rigctld in line | 
					
						
							| 
									
										
										
										
											2016-01-12 21:53:53 +00:00
										 |  |  | # response mode.  See the rigctld(1) man page for details. | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +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-01-24 23:24:20 +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-01-24 23:24:20 +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-01-28 12:26:45 +00:00
										 |  |  | # | 
					
						
							|  |  |  | # See the file 'COPYING' in the main Hamlib distribution directory for the | 
					
						
							|  |  |  | # complete text of the GNU Public License version 2. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Perl modules this script uses | 
					
						
							|  |  |  | use warnings; | 
					
						
							|  |  |  | use strict; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | use IO::Socket; | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | use Getopt::Long; | 
					
						
							|  |  |  | use Pod::Usage; | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | # Global variables | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | my $socket; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | my $host = 'localhost'; | 
					
						
							|  |  |  | my $port = 4532; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | my $vfo = ''; | 
					
						
							|  |  |  | my %rig_state = ();     # State of the rig--freq, mode, passband, ptt, etc. | 
					
						
							|  |  |  | my %rig_caps = ();      # Rig capabilities from \dump_caps | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | my $man = 0; | 
					
						
							|  |  |  | my $help = 0; | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  | my $debug = 0; | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | my $user_in; | 
					
						
							|  |  |  | my $ret_val; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | # Error values returned from rigctld by Hamlib name | 
					
						
							|  |  |  | my %errstr = ( | 
					
						
							| 
									
										
										
										
											2012-08-22 02:54:50 +00:00
										 |  |  |     RIG_OK          => "0",     # No error, operation completed successfully | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +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 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 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | # testctld specific error values from -100 onward | 
					
						
							|  |  |  |     CTLD_OK         => "-100",  # testctld -- No error | 
					
						
							|  |  |  |     CTLD_ENIMPL     => "-103",  # testctld -- %rig_caps reports backend function not implemented | 
					
						
							|  |  |  |     CTLD_EPROTO     => "-108",  # testctld -- Echoed command mismatch or other error | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Error values returned from rigctld by Hamlib value | 
					
						
							|  |  |  | my %errval = reverse %errstr; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							|  |  |  | # Main program | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # Parse command line options | 
					
						
							|  |  |  | argv_opts(); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-24 23:24:20 +00:00
										 |  |  | # Create the new socket. | 
					
						
							|  |  |  | # 'localhost' may be replaced by any hostname or IP address where a | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | # rigctld instance is running. | 
					
						
							|  |  |  | # Timeout is set to 5 seconds. | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | $socket = new IO::Socket::INET (PeerAddr    => $host, | 
					
						
							|  |  |  |                                 PeerPort    => $port, | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  |                                 Proto       => 'tcp', | 
					
						
							|  |  |  |                                 Type        => SOCK_STREAM, | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |                                 Timeout     => 5 ) | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  |     or die $@; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2020-05-31 02:41:58 +00:00
										 |  |  | print "Welcome to testctld.pl a program to test 'rigctld'\n"; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | print "Type '?' or 'help' for commands help.\n\n"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Populate %rig_caps from \dump_caps | 
					
						
							|  |  |  | $ret_val = dump_caps(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Tell user what radio rigctld is working with | 
					
						
							|  |  |  | if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |     print "Hamlib Model: " . $rig_caps{'Caps dump for model'} . "\t"; | 
					
						
							|  |  |  |     print "Common Name: " . $rig_caps{'Mfg name'} . ' ' . $rig_caps{'Model name'} . "\n\n\n"; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | } else { | 
					
						
							|  |  |  |     errmsg ($ret_val); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Check rigctld's response to the \chk_vfo command to see if it was | 
					
						
							|  |  |  | # invoked with the -o|--vfo option.  If true, all commands must include VFO as | 
					
						
							|  |  |  | # first parameter after the command | 
					
						
							|  |  |  | if (chk_opt($socket, 'CHKVFO')) { | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |     $vfo = 'currVFO';       # KISS--One could use the VFO key from %rig_state after calling the \get_vfo command... | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # Interactive loop | 
					
						
							|  |  |  | do { | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     print "rigctld command: "; | 
					
						
							|  |  |  |     chomp($user_in = <>); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # F, \set_freq | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     if ($user_in =~ /^(F|\\set_freq)\s+(\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set Frequency'} eq 'Y') { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             # Get the entered frequency value | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |             print "Freq = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_freq', $vfo, $2); | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # f, \get_freq | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(f|\\get_freq)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get Frequency'} eq 'Y') { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             # Query rig and process result | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_freq', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |                 print "Frequency: " . $rig_state{Frequency} . "\n\n"; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         } else { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # M, \set_mode | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(M|\\set_mode)\s+([A-Z]+)\s+(\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set Mode'} eq 'Y') { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             # Get the entered mode and passband values | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |             print "Mode = $2, Passband = $3\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_mode', $vfo, $2, $3); | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # m, \get_mode | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(m|\\get_mode)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get Mode'} eq 'Y') { | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             # Do the same for the mode (reading the mode also returns the bandwidth) | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_mode', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |                 print "Mode: " . $rig_state{Mode} . "\n"; | 
					
						
							|  |  |  |                 print "Passband: " . $rig_state{Passband} . "\n\n"; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # V, \set_vfo | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(V|\\set_vfo)\s+([A-Za-z]+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set VFO'} eq 'Y') { | 
					
						
							|  |  |  |             print "VFO = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_vfo', $2); # $vfo not used! | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # v, \get_vfo | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(v|\\get_vfo)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get VFO'} eq 'Y') { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             $ret_val = rig_cmd('get_vfo', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |                 print "VFO: " . $rig_state{VFO} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # J, \set_rit | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(J|\\set_rit)\s+([+-]?\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set RIT'} eq 'Y') { | 
					
						
							|  |  |  |             print "RIT freq = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_rit', $vfo, $2); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # j, \get_rit | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(j|\\get_rit)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get RIT'} eq 'Y') { | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_rit', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "RIT: " . $rig_state{RIT} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # Z, \set_xit | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(Z|\\set_xit)\s+([+-]?\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set XIT'} eq 'Y') { | 
					
						
							|  |  |  |             print "XIT freq = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_xit', $vfo, $2); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # z, \get_xit | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(z|\\get_xit)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get XIT'} eq 'Y') { | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_xit', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "XIT: " . $rig_state{XIT} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # T, \set_ptt | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(T|\\set_ptt)\s+(\d)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set PTT'} eq 'Y') { | 
					
						
							|  |  |  |             print "PTT = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_ptt', $vfo, $2); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # t, \get_ptt | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(t|\\get_ptt)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get PTT'} eq 'Y') { | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_ptt', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "PTT: " . $rig_state{PTT} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # S, \set_split_vfo | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(S|\\set_split_vfo)\s+(\d)\s+([A-Za-z]+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set Split VFO'} eq 'Y') { | 
					
						
							|  |  |  |             print "split = $2, VFO = $3\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_split_vfo', $vfo, $2, $3); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # s, \get_split_vfo | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(s|\\get_split_vfo)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get Split VFO'} eq 'Y') { | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_split_vfo', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "Split: " . $rig_state{Split} . "\n"; | 
					
						
							|  |  |  |                 print "TX VFO: " . $rig_state{'TX VFO'} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # I, \set_split_freq | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(I|\\set_split_freq)\s+(\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set Split Freq'} eq 'Y') { | 
					
						
							|  |  |  |             print "TX VFO freq = $2\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_split_freq', $vfo, $2); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # i, \get_split_freq | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(i|\\get_split_freq)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get Split Freq'} eq 'Y') { | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_split_freq', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "TX Frequency: " . $rig_state{'TX Frequency'} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # X, \set_split_mode | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(X|\\set_split_mode)\s+([A-Z]+)\s+(\d+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can set Split Mode'} eq 'Y') { | 
					
						
							|  |  |  |             # Get the entered mode and passband values | 
					
						
							|  |  |  |             print "TX Mode = $2, TX Passband = $3\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('set_split_mode', $vfo, $2, $3); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             unless ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # x, \get_split_mode | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(x|\\get_split_mode)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get Split Mode'} eq 'Y') { | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             # Do the same for the mode (reading the mode also returns the bandwidth) | 
					
						
							|  |  |  |             $ret_val = rig_cmd('get_split_mode', $vfo); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "TX Mode: " . $rig_state{'TX Mode'} . "\n"; | 
					
						
							|  |  |  |                 print "TX Passband: " . $rig_state{'TX Passband'} . "\n\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # 2, \power2mW | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(2|\\power2mW)\s+(\d\.\d+)\s+(\d+)\s+([A-Za-z]+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get power2mW'} eq 'Y') { | 
					
						
							|  |  |  |             print "Power = $2, freq = $3, VFO = $4\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('power2mW', $2, $3, $4); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "Power mW: " . $rig_state{'Power mW'} . "\n"; | 
					
						
							|  |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # 4, \mW2power | 
					
						
							|  |  |  |     elsif ($user_in =~ /^(4|\\mW2power)\s+(\d+)\s+(\d+)\s+([A-Za-z]+)\b$/) { | 
					
						
							|  |  |  |         if ($rig_caps{'Can get mW2power'} eq 'Y') { | 
					
						
							|  |  |  |             print "mW = $2, freq = $3, VFO = $4\n" if $debug; | 
					
						
							|  |  |  |             $ret_val = rig_cmd('mW2power', $2, $3, $4); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |                 print "Power [0.0..1.0]: " . $rig_state{'Power [0.0..1.0]'} . "\n"; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             } else { | 
					
						
							|  |  |  |                 errmsg ($ret_val); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } else { | 
					
						
							|  |  |  |             errmsg($errstr{'CTLD_ENIMPL'}); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # 1, \dump_caps | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^(1|\\dump_caps)\b$/) { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         $ret_val = dump_caps(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         if ($ret_val eq $errstr{'RIG_OK'}) { | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |             print "Model: " . $rig_caps{'Caps dump for model'} . "\n"; | 
					
						
							|  |  |  |             print "Manufacturer: " . $rig_caps{'Mfg name'} . "\n"; | 
					
						
							|  |  |  |             print "Name: " . $rig_caps{'Model name'} . "\n\n"; | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         } else { | 
					
						
							|  |  |  |             errmsg ($ret_val); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # ?, help | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     elsif ($user_in =~ /^\?|^help\b$/) { | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         print <<EOF; | 
					
						
							| 
									
										
										
										
											2008-01-10 03:42:35 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2016-01-12 21:53:53 +00:00
										 |  |  | Commands are entered in the same format as described in the rigctld(1) | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | man page.  e.g. lower case letters call \\get commands and upper case | 
					
						
							|  |  |  | letters call \\set commands or long command names may be used. | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | Values passed to set commands are separated by a single space: | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | F 28400000 | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | \\set_mode USB 2400 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2020-05-31 02:41:58 +00:00
										 |  |  | See 'man rigctld' for complete command descriptions. | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  | Type 'q' or 'exit' to exit $0. | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | EOF | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  |     elsif ($user_in !~ /^(exit|q)\b$/i) { | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         print "Unrecognized command.  Type '?' or 'help' for command help.\n" | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  | } while ($user_in !~ /^(exit|q)\b$/i); | 
					
						
							| 
									
										
										
										
											2008-01-06 15:46:11 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Close the connection before we exit. | 
					
						
							|  |  |  | close($socket); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # Subroutines for interacting with rigctld | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | # | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | 
					
						
							|  |  |  | # rig_cmd -- Build command string, check returned data, and populate %rig_state | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Passed parameters: | 
					
						
							|  |  |  | # $cmd      = rigctld command | 
					
						
							|  |  |  | # $vfo      = VFO argument (may be null) | 
					
						
							|  |  |  | # $p1 - $p3 = \set command parameters | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Returns error value from rigctld or local error value if echoed command mismatch | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | sub rig_cmd { | 
					
						
							|  |  |  |     my ($errno, @answer); | 
					
						
							|  |  |  |     my $cmd = shift @_; | 
					
						
							|  |  |  |     my $vfo = shift @_; | 
					
						
							|  |  |  |     my $p1 = shift @_; | 
					
						
							|  |  |  |     my $p2 = shift @_; | 
					
						
							|  |  |  |     my $p3 = shift @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # Add a space to the beginning of the $vfo and $p? arguments | 
					
						
							|  |  |  |     if ($vfo) { | 
					
						
							|  |  |  |         $vfo = sprintf("%*s", 1 + length $vfo, $vfo); | 
					
						
							|  |  |  |     } else { $vfo = ''; } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     if (defined $p1) { | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |         # "Stringify" parameter value then add a space to the beginning of the string | 
					
						
							|  |  |  |         $p1 .= ''; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         $p1 = sprintf("%*s", 1 + length $p1, $p1); | 
					
						
							|  |  |  |     } else { $p1 = ''; } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     if (defined $p2) { | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |         $p2 .= ''; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         $p2 = sprintf("%*s", 1 + length $p2, $p2); | 
					
						
							|  |  |  |     } else { $p2 = ''; } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     if (defined $p3) { | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |         $p3 .= ''; | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         $p3 = sprintf("%*s", 1 + length $p3, $p3); | 
					
						
							|  |  |  |     } else { $p3 = ''; } | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  |     print '+\\' . $cmd . $vfo . $p1 . $p2 . $p3 . "\n\n" if $debug; | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |     # N.B. Terminate query commands with a newline, e.g. "\n" character. | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  |     # N.B. Preceding '+' char to request line separated extended response protocol | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  |     print $socket '+\\' . $cmd . $vfo . $p1 . $p2 . $p3 . "\n"; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     # rigctld echoes the command plus value(s) on "get" along with | 
					
						
							|  |  |  |     # separate lines for the queried value(s) and the Hamlib return value. | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |     @answer = get_rigctl($socket); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     if ((shift @answer) =~ /^$cmd:/) { | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |         $errno = get_errno(pop @answer); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         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 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 for each | 
					
						
							|  |  |  |             # returned line. | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |             if (@answer) { get_state(@answer) } # Empty array on \set commands | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |         } | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         return $errno; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     } else { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         return $errstr{'CTLD_EPROTO'}; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | # Get the rig capabilities from Hamlib and store in the %rig_caps hash. | 
					
						
							|  |  |  | sub dump_caps { | 
					
						
							|  |  |  |     my ($cmd, $errno, @answer); | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  |     print $socket "+\\dump_caps\n"; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |     @answer = get_rigctl($socket); | 
					
						
							|  |  |  |     $cmd = shift @answer; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     if ($cmd =~ /^dump_caps:/) { | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |         $errno = get_errno(pop @answer); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         if ($errno eq $errstr{'RIG_OK'}) { | 
					
						
							|  |  |  |             get_caps(@answer); | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |         } | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         return $errno; | 
					
						
							|  |  |  |     } else { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         return $errstr{'RIG_EPROTO'}; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | ############################################################################# | 
					
						
							|  |  |  | # testctld.pl helper functions | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | ############################################################################# | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # 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 { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     my $sock = shift @_; | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |     my @lines; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     while (<$sock>) { | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |         # rigctld terminates each line with '\n' | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         chomp; | 
					
						
							|  |  |  |         push @lines, $_; | 
					
						
							|  |  |  |         return @lines if $_ =~ /^RPRT/; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Builds the %rig_state hash from the lines returned by rigctld which are of the | 
					
						
							|  |  |  | # form "Frequency: 14250000", "Mode: USB", "Passband: 2400", etc. | 
					
						
							|  |  |  | sub get_state { | 
					
						
							|  |  |  |     my ($key, $val); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     foreach (@_) { | 
					
						
							|  |  |  |         ($key, $val) = split(/: /, $_); | 
					
						
							|  |  |  |         $rig_state{$key} = $val; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # Parse the (large) \dump_caps command response into %rig_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+/, $_); | 
					
						
							|  |  |  |             $rig_caps{$key} = $val; | 
					
						
							|  |  |  |         } | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # Extract the Hamlib error value returned with the last line from rigctld | 
					
						
							|  |  |  | sub get_errno { | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     chomp @_; | 
					
						
							|  |  |  |     my @errno = split(/ /, $_[0]); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     return $errno[1]; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | # check for VFO mode from rigctld | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | sub chk_opt { | 
					
						
							|  |  |  |     my $sock = shift @_; | 
					
						
							|  |  |  |     my @lines; | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-08 23:38:08 +00:00
										 |  |  |     if ($_[0] =~ /^CHKVFO/) { | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |         print $sock "\\chk_vfo\n"; | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  |     } | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |     while (<$sock>) { | 
					
						
							|  |  |  |         # rigctld terminates each line with '\n' | 
					
						
							|  |  |  |         chomp; | 
					
						
							|  |  |  |         push @lines, $_;     # Should only be one line, but be sure | 
					
						
							|  |  |  |         last if $_ =~ /^$_[0]/; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
											
												Fix spelling errors
Fixed using the following command:
codespell --write-changes --summary --skip=*.m4 --ignore-words-list="develope,get's,quitt,setts,som,ue,vektor"
codespell --write-changes --summary --skip=aclocal.m4,lib --ignore-words-list="develope,get's,quitt,setts,som,ue,vektor"
Codespell home page: https://github.com/codespell-project/codespell
											
										 
											2020-07-24 07:02:12 +00:00
										 |  |  |     # The CHK* line will have a space separated integer of 0 or 1 | 
					
						
							| 
									
										
										
										
											2020-05-31 02:41:58 +00:00
										 |  |  |     # for 'rigctld' invocation without and with -b|--block or | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     # -o|--vfo options respectively | 
					
						
							|  |  |  |     foreach (@lines) { | 
					
						
							|  |  |  |         if ($_ =~ /^$_[0]\s(\d)/) { | 
					
						
							|  |  |  |             return $1; | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  | # FIXME:  Better argument handling | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | sub errmsg { | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-04 00:58:44 +00:00
										 |  |  |     unless (($_[0] eq $errstr{'CTLD_EPROTO'}) or ($_[0] eq $errstr{'CTLD_ENIMPL'})) { | 
					
						
							|  |  |  |         print "rigctld 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 rig backend\n\n"; | 
					
						
							|  |  |  |     } | 
					
						
							| 
									
										
										
										
											2010-01-25 03:44:25 +00:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  | # 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; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | # POD for pod2usage | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | __END__
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 NAME | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2020-05-31 02:41:58 +00:00
										 |  |  | testctld.pl - A test and example program for 'rigctld' written in Perl. | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | =head1 SYNOPSIS | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | testctld.pl [options] | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |  Options: | 
					
						
							| 
									
										
										
										
											2020-05-31 02:41:58 +00:00
										 |  |  |     --host          Hostname or IP address of target 'rigctld' process | 
					
						
							|  |  |  |     --port          TCP Port of target 'rigctld' process | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  |     --help          Brief help message | 
					
						
							|  |  |  |     --man           Full documentation | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  |     --debug         Enable debugging output | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | =head1 DESCRIPTION | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | B<testcld.pl> provides a set of functions to interactively test the Hamlib | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | I<rigctld> TCP/IP network daemon.  It also aims to be an example of programming | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | code to control a radio via TCP/IP in Hamlib. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 OPTIONS | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 8 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<--host> | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | Hostname or IP address of the target I<rigctld> process.  Default is I<localhost> | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | which should resolve to 127.0.0.1 if I</etc/hosts> is configured correctly. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<--port> | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
											
												Fix spelling errors
Fixed using the following command:
codespell --write-changes --summary --skip=*.m4 --ignore-words-list="develope,get's,quitt,setts,som,ue,vektor"
codespell --write-changes --summary --skip=aclocal.m4,lib --ignore-words-list="develope,get's,quitt,setts,som,ue,vektor"
Codespell home page: https://github.com/codespell-project/codespell
											
										 
											2020-07-24 07:02:12 +00:00
										 |  |  | TCP port of the target I<rigctld> process.  Default is 4532.  Multiple instances | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | of I<rigctld> will require unique port numbers. | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | =item B<--help> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Prints a brief help message and exits. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<--man> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Prints this manual page and exits. | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-06 15:07:28 +00:00
										 |  |  | =item B<--debug> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Enables debugging output to the console. | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | =head1 COMMANDS | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2016-01-12 21:53:53 +00:00
										 |  |  | Commands are the same as described in the rigctld(1) man page.  This is only | 
					
						
							| 
									
										
										
										
											2010-02-18 00:18:54 +00:00
										 |  |  | a brief summary. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     F, \set_freq        Set frequency in Hz | 
					
						
							|  |  |  |     f, \get_freq        Get frequency in Hz | 
					
						
							|  |  |  |     M, \set_mode        Set mode including passband in Hz | 
					
						
							|  |  |  |     m, \get_mode        Get mode including passband in Hz | 
					
						
							|  |  |  |     V, \set_vfo         Set VFO (VFOA, VFOB, etc.) | 
					
						
							|  |  |  |     v, \get_vfo         Get VFO (VFOA, VFOB, etc.) | 
					
						
							|  |  |  |     J, \set_rit         Set RIT in +/-Hz, '0' to clear | 
					
						
							|  |  |  |     j, \get_rit         Get RIT in +/-Hz, '0' indicates Off | 
					
						
							|  |  |  |     Z, \set_xit         Set XIT in +/-Hz, '0' to clear | 
					
						
							|  |  |  |     z, \get_rit         Get XIT in +/-Hz, '0' indicates Off | 
					
						
							|  |  |  |     T, \set_ptt         Set PTT, '1' On, '0' Off | 
					
						
							|  |  |  |     t, \get_ptt         Get PTT, '1' indicates On, '0' indicates Off | 
					
						
							|  |  |  |     S, \set_split_vfo   Set rig into "split" VFO mode, '1' On, '0' Off | 
					
						
							|  |  |  |     s, \get_split_vfo   Get status of :split" VFO mode, '1' On, '0' Off | 
					
						
							|  |  |  |     I, \set_split_freq  Set TX VFO frequency in Hz | 
					
						
							|  |  |  |     i, \get_split_freq  Get TX VFO frequency in Hz | 
					
						
							|  |  |  |     X, \set_split_mode  Set TX VFO mode including passband in Hz | 
					
						
							|  |  |  |     x, \get_split_mode  Get TX VFO mode including passband in Hz | 
					
						
							|  |  |  |     2, \power2mW        Translate a power value [0.0..1.0] to milliWatts | 
					
						
							|  |  |  |     4, \mW2power        Translate milliWatts to a power value [0.0..1.0] | 
					
						
							|  |  |  |     1, \dump_caps       Get the rig capabilities and display select values. | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-01-28 12:26:45 +00:00
										 |  |  | =cut |