kopia lustrzana https://github.com/jamescoxon/dl-fldigi
Update fldigi-shell
Fix wait_for_data() Add source command Add -c argument File arguments are now evaluated as Perl code Remove old commentspull/2/head
rodzic
3d6f7bbf84
commit
2b79053f99
|
@ -1,7 +1,7 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# ----------------------------------------------------------------------------
|
||||
# fldigi-shell version 0.35
|
||||
# fldigi-shell version 0.36
|
||||
# A program to control fldigi over HTTP/XML-RPC.
|
||||
#
|
||||
# Fldigi must have been built with xml-rpc support; see INSTALL.
|
||||
|
@ -33,7 +33,7 @@ use POSIX qw(:termios_h);
|
|||
use IO::Handle;
|
||||
use Getopt::Std;
|
||||
use Data::Dumper;
|
||||
use Time::HiRes qw(gettimeofday tv_interval);
|
||||
use Time::HiRes qw(gettimeofday tv_interval usleep);
|
||||
|
||||
################################################################################
|
||||
|
||||
|
@ -51,6 +51,8 @@ our %methods;
|
|||
our %commands;
|
||||
our %encoders;
|
||||
|
||||
our %opts;
|
||||
|
||||
################################################################################
|
||||
# terminal routines from perlfaq8
|
||||
|
||||
|
@ -174,7 +176,7 @@ sub help
|
|||
next unless (exists($methods{$_}));
|
||||
printf($OUT " %-32s%-8s%s\n", $_, $methods{$_}->[0], $methods{$_}->[1]);
|
||||
}
|
||||
print $OUT "\n";
|
||||
print $OUT "\n" if (!@_);
|
||||
}
|
||||
print $OUT "Shell commands:", "\n" if (!@_);
|
||||
foreach (@k) {
|
||||
|
@ -282,7 +284,7 @@ sub wait_for_state
|
|||
{
|
||||
warn "not enough arguments\n" and return unless (@_);
|
||||
my $r;
|
||||
sleep(1) while (defined($r = req("main.get_tx_status")) && $r->value ne $_[0]);
|
||||
sleep(1) while (defined($r = req("main.get_trx_status")) && $r->value ne $_[0]);
|
||||
}
|
||||
|
||||
sub time_cmd
|
||||
|
@ -292,17 +294,28 @@ sub time_cmd
|
|||
print tv_interval($t0), " seconds\n";
|
||||
}
|
||||
|
||||
sub evaluate(@)
|
||||
{
|
||||
warn "$@" unless (defined(eval "@_"));
|
||||
}
|
||||
|
||||
sub source
|
||||
{
|
||||
open(IN, '<', $_[0]) or warn "Could not read input file: $!\n" and return;
|
||||
evaluate(<IN>);
|
||||
close(IN);
|
||||
}
|
||||
|
||||
################################################################################
|
||||
|
||||
our %opts = ( "u" => "http://localhost:7362/RPC2", "d" => 0 );
|
||||
%opts = ( "c" => "", "d" => 0, "u" => "http://localhost:7362/RPC2" );
|
||||
|
||||
%commands = ( "help" => [ "n:n", "Print this command help", \&help ],
|
||||
"poll" => [ "s:i", "Poll for RX text every ``i'' seconds (def=1)", \&recv_text ],
|
||||
"send" => [ "n:s", "Send text, one line at a time", \&send_line ],
|
||||
"sendchar" => [ "n:s", "Send text, one character at a time", \&send_char ],
|
||||
"exit" => [ "n:n", "Exit the shell", sub { exit(0) } ],
|
||||
"eval" => [ "s:s", "Evaluate Perl code", sub { eval "@_"; } ],
|
||||
"eval" => [ "s:s", "Evaluate Perl code", sub { evaluate "@_"; } ],
|
||||
"history" => [ "s:n", "Print command history", sub { print_history($OUT, 0); } ],
|
||||
"debug" => [ "n:n", "Toggle debugging output", sub { $debug = (@_ ? $_[0] : !$debug); } ],
|
||||
"reinit" => [ "n:n", "Rebuild command list", sub { build_cmds(); setup_compl(); } ],
|
||||
|
@ -310,6 +323,7 @@ our %opts = ( "u" => "http://localhost:7362/RPC2", "d" => 0 );
|
|||
"recvtext" => [ "s:n", "Get all received text", \&get_recv_text ],
|
||||
"sendfile" => [ "n:s", "Send text from file ``s''", \&send_file ],
|
||||
"sendstr" => [ "n:s", "Send string ``s''", sub { send_line(@_); } ],
|
||||
"source" => [ "n:s", "Read commands from file ``s''", sub { source(@_) } ],
|
||||
"wait" => [ "n:s", "Wait for trx state to become ``s''", \&wait_for_state ],
|
||||
"time" => [ "s:s", "Time a command", \&time_cmd ]
|
||||
);
|
||||
|
@ -328,14 +342,20 @@ sub HELP_MESSAGE
|
|||
{
|
||||
print <<EOF
|
||||
|
||||
Usage: $progname [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
|
||||
Usage: $progname [-OPTIONS [-MORE_OPTIONS]] [--] [FILE ...]
|
||||
|
||||
The following single-character options are accepted:
|
||||
|
||||
-c CMD Execute command CMD and exit.
|
||||
|
||||
-d Enable debugging output.
|
||||
|
||||
-u URL Use URL to access the server.
|
||||
The default is $opts{"u"}
|
||||
|
||||
-d Enable debugging output.
|
||||
Files are evaluated as Perl code and may contain
|
||||
execute("COMMAND [ARG ...]") statements, where COMMAND
|
||||
is an fldigi-shell command.
|
||||
|
||||
Options may be merged together. -- stops processing of options.
|
||||
Space is not required between options and their arguments.
|
||||
|
@ -347,11 +367,25 @@ sub handle_cmdline
|
|||
{
|
||||
$Getopt::Std::STANDARD_HELP_VERSION = 1;
|
||||
|
||||
my $optstr = 'c:du:';
|
||||
my $old_warn_handler = $SIG{__WARN__};
|
||||
$SIG{__WARN__} = sub { die $_[0]; };
|
||||
getopts('du:', \%opts);
|
||||
getopts($optstr, \%opts);
|
||||
$SIG{__WARN__} = $old_warn_handler;
|
||||
|
||||
my @argopts;
|
||||
my $last = 0;
|
||||
foreach (split(//, $optstr)) {
|
||||
push(@argopts, $last) if ($_ eq ":");
|
||||
$last = $_;
|
||||
}
|
||||
foreach (@argopts) {
|
||||
if (exists($opts{$_}) && !defined($opts{$_})) {
|
||||
die "$0: option `-$_' requires an argument\n";
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
$debug = $opts{"d"};
|
||||
}
|
||||
|
||||
|
@ -361,18 +395,6 @@ sub build_cmds
|
|||
{
|
||||
%methods = ();
|
||||
|
||||
# FIXME: This is quite slow. We should use a multicall request.
|
||||
# if (defined(my $r = req("system.listMethods"))) {
|
||||
# my @ma = @{$r->value};
|
||||
# for my $m (@ma) {
|
||||
# $r = req("system.methodSignature", $m);
|
||||
# my @sa = @{$r->value->[0]};
|
||||
# $r = req("system.methodHelp", $m);
|
||||
# my $sig = join("", map { $abbrev{$_} } @sa); $sig =~ s/^(.)/$1:/;
|
||||
# $methods{$m} = [ $sig, $r->value ];
|
||||
# }
|
||||
# }
|
||||
|
||||
# this uses fldigi.list to get all non-system methods with a single request
|
||||
if (defined(my $r = req("fldigi.list"))) {
|
||||
foreach (@{$r->value}) {
|
||||
|
@ -438,8 +460,12 @@ my $histskip = load_history();
|
|||
# build commands hashes
|
||||
build_cmds();
|
||||
|
||||
if (@ARGV) { # execute arguments and exit
|
||||
execute($_) foreach (@ARGV);
|
||||
if ($opts{'c'} ne "") { # execute argument and exit
|
||||
execute($opts{'c'});
|
||||
exit(0);
|
||||
}
|
||||
elsif (@ARGV) {
|
||||
source($_) foreach(@ARGV);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
|
|
Ładowanie…
Reference in New Issue