YFKlog Perl Ham Radio logger: https://fkurz.net/ham/yfklog.html
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2522 lines
97 KiB
2522 lines
97 KiB
#!/usr/bin/perl |
|
|
|
# indentation looks best with tw=4 |
|
|
|
# yfklog - a general purpose ham radio logbook |
|
# |
|
# Copyright (C) 2005-2019 Fabian Kurz, DJ1YFK |
|
# |
|
# This program is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# This program is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with this program; if not, write to the |
|
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
# Boston, MA 02111-1307, USA. |
|
|
|
use strict; # No shabby code beyond this point :) |
|
use DBI; # Database interface |
|
use Curses; |
|
use Net::FTP; # upload of online log or backup |
|
|
|
use threads ('yield', 'stack_size' => 64*4096, 'exit' => 'threads_only', 'stringify'); |
|
use threads::shared; |
|
|
|
# terminal size (will be queried later) |
|
our $col; |
|
our $row; |
|
|
|
# window/terminal size changed |
|
$SIG{'WINCH'} = sub { |
|
&redraw(); |
|
}; |
|
|
|
my $prefix="/usr"; |
|
|
|
if (-f './yfk' && -f './yfksubs.pl' && -f 'THANKS') { |
|
# we're in the source directory, source the local copy |
|
require "./yfksubs.pl"; |
|
} else { |
|
require "$prefix/share/yfklog/yfksubs.pl"; |
|
} |
|
import yfksubs; |
|
|
|
our $yfkver = '0.6.0'; # Program Version |
|
our $VERSION = $yfkver; |
|
|
|
|
|
# Here we give some variables their default values. Some of them will be |
|
# changed later when reading the config-file .yfklog. |
|
|
|
my $firstrun = 1; # At first run, start in setup mode, and create DBs. |
|
my $mycall=''; # will be the callsign of the active log |
|
my $dband="80"; # default band 80m. 3525kHz precisely :-) |
|
my $bands = '160 80 40 30 20 17 15 12 10 2'; # bands for award purposes |
|
my $modes = 'CW SSB'; # modes for award purposes |
|
my $dmode="CW"; # of course we want CW as default mode |
|
my $dpwr ="100"; # life is too long for QRO |
|
my $dqsls="Q"; # default QSL sent: Q = put in queue |
|
my $dqslr="N"; # default QSL recvd: N - No |
|
my $workcall = ""; # The station we are currently working |
|
my $status=16; # status: 1: Logging 2: menu 3: QSL mode 15: setup |
|
my @wi; # contains the windows inside the input-window |
|
# 0 Callsign, 1 Date, 2 time on, 3 time off |
|
# 4 QRG, 5 Mode, 6 QTH, 7 Name, 8 QSL-TX, 9 QSL-RX |
|
# 10 RSTs, 11 RSTr, 12 Remarks, 13 PWR |
|
my @qso = ("","","","", # Data of the current QSO which is read from input. |
|
"","","","","","","","" # 0 Callsign, 1 Date, 2 time on, 3 time off |
|
,"",""); # 4 QRG, 5 Mode, 6 QTH, 7 Name, 8 QSL-TX, 9 QSL-RX |
|
# 10 RSTs, 11 RSTr, 12 Remarks, 13 PWR, 14 ser. nr. |
|
# (Ser. nr. is appended to RSTs field and increased |
|
# only on successfully saved QSO) |
|
my $qso = \@qso; # QSO reference |
|
my $editnr=0; # the QSO which we are editing. 0 = no QSO is edited nw |
|
my $screenlayout=0; # screen layout - 0 or 1 |
|
my $colors=1; |
|
my $dbname=''; |
|
my $dbserver=''; |
|
my $directory='/tmp'; |
|
my $qsldetails=1; # show details of QSO in Write mode? |
|
my $drem=""; # default remarks |
|
my $serial=0; # Auto serial number for casual contesting |
|
# Set to nonzero value to start logging with this number |
|
$qso[14] = -1; # serial number saved here; -1 means not set yet |
|
|
|
sub readconfig { |
|
|
|
unless (-e "$ENV{HOME}/.yfklog/config") { return 0; } |
|
|
|
open CONFIG, "$ENV{HOME}/.yfklog/config" or die "Cannot open configuration file. Error: $!"; |
|
|
|
while (defined (my $line = <CONFIG>)) { # Read line into $line |
|
if ($line =~ /^mycall=(.+)/) { $mycall= "\L$1"; } |
|
if ($line =~ /^dband=(.+)/) { $dband= $1; } |
|
if ($line =~ /^awardbands=(.+)/) { $bands = $1; } |
|
if ($line =~ /^awardmodes=(.+)/) { $modes = $1; } |
|
if ($line =~ /^dmode=(.+)/) { $dmode= $1; } |
|
if ($line =~ /^dpwr=(.+)/) { $dpwr= $1; } |
|
if ($line =~ /^dqsls=(.+)/) { $dqsls = $1; } |
|
if ($line =~ /^dqslr=(.+)/) { $dqslr = $1; } |
|
if ($line =~ /^screenlayout=(.+)/) { $screenlayout = $1; } |
|
if ($line =~ /^dbname=(.+)/) { $dbname= $1; } |
|
if ($line =~ /^dbserver=(.+)/) { $dbserver = $1; } |
|
if ($line =~ /^directory=(.+)/) { $directory = $1; } |
|
if ($line =~ /^colors=(.+)/) { $colors = $1; } |
|
if ($line =~ /^qsldetails=(.+)/) { $qsldetails = $1; } |
|
if ($line =~ /^drem=(.+)/) { $drem= $1; } |
|
if ($line =~ /^serial=(.+)/) { $serial = $1; } |
|
} |
|
close CONFIG; |
|
|
|
return 1; |
|
} |
|
|
|
initscr; # we go into curses mode |
|
noecho; # keyboard input will not be echoed |
|
keypad(1); # enable keys like F1, F2,.. cursor keys etc. |
|
if (!has_colors && $colors) { # we need colors, if not available, die |
|
die "No colors"; } |
|
start_color if $colors;; # got colors! |
|
mycurs_set(0); # cursor invisible |
|
|
|
getmaxyx($row, $col); |
|
$row-- if ($row % 2); # force even number of rows |
|
|
|
printw &splashscreen($yfkver); |
|
|
|
# Check if a config-file exists. Otherwise make one. |
|
if (&readconfig) { |
|
$firstrun = 0; |
|
$status = 2; |
|
} |
|
else { |
|
printw "\n\nCouldn't find ~/.yfklog. Seems to be your first run.\n"; |
|
printw "Going to setup mode now, most default values should be\n"; |
|
printw "OK for now. You only have to set your 'mycall' and (if\n"; |
|
printw "MySQL instead of SQlite is used) the DB settings.\n"; |
|
printw "\n"; |
|
printw "Refer to the manual for more information.\n"; |
|
printw "\n"; |
|
printw "Press any key to continue.\n"; |
|
|
|
# YFklog needs: db_calls.sql db_clubs.sql db_config.sql db_log.sql |
|
# db_log.sqlite config |
|
|
|
if ((-e $prefix.'/share/yfklog/config') && |
|
(-e $prefix.'/share/yfklog/db_calls.sql') && |
|
(-e $prefix.'/share/yfklog/db_clubs.sql') && |
|
(-e $prefix.'/share/yfklog/db_config.sql') && |
|
(-e $prefix.'/share/yfklog/db_log.sql') && |
|
(-e $prefix.'/share/yfklog/db_log.sqlite')) { |
|
mkdir "$ENV{'HOME'}/.yfklog/"; |
|
system("install -m 644 $prefix/share/yfklog/config $ENV{'HOME'}/.yfklog/"); |
|
&readconfig; # Read config here |
|
&readsubconfig; # and in yfksubs |
|
} |
|
else { |
|
die "First run: Couldn't find the files needed in $prefix/share/yfklog\n". |
|
"db_calls.sql db_clubs.sql db_config.sql db_log.sql db_log.sqlite config!\n"; |
|
} |
|
|
|
} |
|
|
|
# if needed, update the database to the current version, create log tables, |
|
# etc.. |
|
|
|
&databaseupgrade(0) unless ($firstrun); |
|
|
|
&waitkey(); |
|
|
|
|
|
# Now the main windows will be generated: |
|
# In every case visible are the windows $whead (the top line, which will show |
|
# status information) and $whelp (the bottom line which will show short help |
|
# instructions). |
|
|
|
# For LOGGING MODE there are 4 windows: The top window is the input mask |
|
# called $winput. Below is $winfo where information about the worked station is |
|
# displayed (DXCC, country name, WPX, Zones, Distance and bearing..). Then the |
|
# window splits up and there are $wlog and $wqsos next to each other. $wlog |
|
# shows the log, $wqsos shows previous QSOs with the station you are currently |
|
# working. |
|
|
|
# The windows have a fixed width and height and assume a 80 x 24 terminal. |
|
# However if you use a larger terminal, no problems should occur. |
|
|
|
if ($colors) { |
|
|
|
init_pair(1, COLOR_BLACK, COLOR_YELLOW); |
|
init_pair(2, COLOR_BLUE, COLOR_GREEN); |
|
init_pair(3, COLOR_BLUE, COLOR_CYAN); |
|
init_pair(4, COLOR_WHITE, COLOR_BLUE); |
|
init_pair(5, COLOR_WHITE, COLOR_BLACK); |
|
init_pair(6, COLOR_WHITE, COLOR_RED); |
|
init_pair(7, COLOR_BLACK, COLOR_YELLOW); |
|
init_pair(8, COLOR_GREEN, COLOR_BLACK); |
|
|
|
} |
|
else { |
|
|
|
init_pair(1, COLOR_WHITE, COLOR_BLACK); |
|
init_pair(2, COLOR_BLACK, COLOR_WHITE); |
|
init_pair(3, COLOR_BLACK, COLOR_WHITE); |
|
init_pair(4, COLOR_WHITE, COLOR_BLACK); |
|
init_pair(5, COLOR_WHITE, COLOR_BLACK); |
|
init_pair(6, COLOR_WHITE, COLOR_BLACK); |
|
init_pair(7, COLOR_BLACK, COLOR_WHITE); |
|
init_pair(8, COLOR_BLACK, COLOR_WHITE); |
|
|
|
} |
|
|
|
our ($whead, $whelp, $winput, $winfo, $wlog, $wqsos, $wedit, $weditlog, $wmain, $wdxc); |
|
# build logging windows (see yfksubs.pl) |
|
&create_windows(); |
|
|
|
# Inside the input-window, the input fields will also be defined as single |
|
# windows, so it will be easy to fill them with data. These are stored in the |
|
# array @wi (windows input). |
|
# The first 14 are used in the log entry in the normal logging mode, another 8 |
|
# windows are only used when editing QSOs in the "Search and Edit" function. |
|
# There you can change ALL fields which are stored in the database, which is |
|
# not possible in the normal QSO entry mask (because it's hardly needed and |
|
# only eats up screen space). |
|
|
|
$wi[0] = &makewindow(1,12,1,6,5); # Input Window: Call |
|
$wi[1] = &makewindow(1,8,1,26,5); # Input Window: Date |
|
$wi[2] = &makewindow(1,4,1,41,5); # Input Window: T on |
|
$wi[3] = &makewindow(1,4,1,53,5); # Input Window: T off |
|
$wi[4] = &makewindow(1,4,1,64,5); # Input Window: Band |
|
$wi[5] = &makewindow(1,5,1,75,5); # Input Window: Mode |
|
$wi[6] = &makewindow(1,13,2,5,5); # Input Window: QTH |
|
$wi[7] = &makewindow(1,8,2,26,5); # Input Window: Name |
|
$wi[8] = &makewindow(1,1,2,42,5); # Input Window: QSLs |
|
$wi[9] = &makewindow(1,1,2,50,5); # Input Window: QSLr |
|
$wi[10] = &makewindow(1,7,2,58,5); # Input Window: RSTs |
|
$wi[11] = &makewindow(1,7,2,72,5); # Input Window: RSTr |
|
$wi[12] = &makewindow(1,56,3,9,5); # Input Window: Remarks |
|
$wi[13] = &makewindow(1,4,3,72,5); # Input Window: Power |
|
|
|
$wi[14] = &makewindow(1,4,4,6,5); # Edit Window: DXCC |
|
$wi[15] = &makewindow(1,8,4,17,5); # Edit Window: PFX |
|
$wi[16] = &makewindow(1,2,4,33,5); # Edit Window: CONT |
|
$wi[17] = &makewindow(1,2,4,43,5); # Edit Window: ITUZ |
|
$wi[18] = &makewindow(1,2,4,51,5); # Edit Window: CQZ |
|
$wi[19] = &makewindow(1,8,4,64,5); # Edit Window: QSLINFO |
|
$wi[20] = &makewindow(1,6,5,6,5); # Edit Window: IOTA |
|
$wi[21] = &makewindow(1,2,5,21,5); # Edit Window: STATE |
|
$wi[22] = &makewindow(1,7,5,72,5); # Window: NR of QSO |
|
$wi[23] = &makewindow(1,1,5,32,5); # Edit Window: QSLRL |
|
$wi[24] = &makewindow(1,6,5,39,5); # Edit Window: OPERATOR |
|
$wi[25] = &makewindow(1,6,5,53,5); # Edit Window: GRID |
|
my $wi = \@wi; # Window reference |
|
|
|
# launch DX cluster if configured |
|
if ($wdxc) { |
|
my $thr = threads->create('rundxc'); |
|
} |
|
|
|
############################################################################## |
|
# MAIN PROGRAM LOOP |
|
# This is the outer loop of the program. Depending on $status, it choses |
|
# between: Log-Input mode ($status = 1), Main menu ($status = 2), QSL-mode |
|
# ($status = 3) ... |
|
############################################################################## |
|
|
|
while (1) { # Loop infinitely; most outer loop. |
|
|
|
redraw(); |
|
|
|
############################################################################## |
|
# LOGGING MODE ($status = 1) |
|
# While the status is 1, we are in logging mode. This means that the windows |
|
# are initialized with proper content and refreshed. Then the logging process |
|
# starts. |
|
############################################################################## |
|
|
|
while ($status == 1) { |
|
my $aw=1; # Active Window during main logging loop. 1 = $winput, |
|
# 2 = $wlog, 3 = $wqsos |
|
my $af=1; # Active field within $winput (Call, Date...) |
|
|
|
# The text which does not change during the log-session is written: |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Logging Mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver"); |
|
addstr($winput, 0,0, &entrymask(0)); # creates the input entry mask |
|
addstr($winput, 1,0, &entrymask(1)); |
|
addstr($winput, 2,0, &entrymask(2)); |
|
addstr($whelp, 0,0, &fkeyline()); # help line (F-keys) |
|
addstr($winfo, 0,0, &winfomask(0)); # Country: ITU: CQZ: etc. |
|
addstr($winfo, 1,0, &winfomask(1)); |
|
addstr($winfo, 2,0, " "x80); |
|
addstr($wqsos, 0,0, " "x($row*80)); # prev qsos window delete |
|
|
|
&lastqsos(\$wlog); # Print last QSOs into $wlog window |
|
|
|
refresh($winfo); |
|
refresh($whead); |
|
refresh($whelp); |
|
refresh($winput); |
|
refresh($wqsos); |
|
|
|
############################################################################## |
|
# LoggingLoop. Starts in (F8) $winput (1), F9 goes to $wlog (2) and then F10 |
|
# to $wqsos (3) (previous QSOs). $aw is the active window. |
|
############################################################################## |
|
|
|
&qsotofields($qso,$wi,1); # fills 14 input field with QSO array |
|
|
|
# Now we loop infinitely until we get out of logging mode ($status==1) |
|
while (1) { |
|
|
|
############################################################################## |
|
# LOGGING INPUT WINDOW $aw = 1 |
|
############################################################################## |
|
|
|
|
|
$af = 1; # start in 1st field (call) |
|
|
|
while ($aw == 1) { # We are in the logging Window |
|
mycurs_set(1); |
|
$workcall = $qso[0]; # The call we are working right now, |
|
# so we can change DXCC etc if it |
|
# changes |
|
|
|
if ($af == 1) { # READ CALLSIGN FIELD |
|
$aw = &readw($wi,0,0,$qso,\$wlog, # Read callsign. See details in sub. |
|
\$editnr, 0, 12); |
|
if ($aw == 1) { # All OK, next field |
|
$af = &jumpfield(1, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK, stay in $aw=1 |
|
$af = &jumpfield(1, 'p'); |
|
$aw = 1; |
|
} |
|
# When a new callsign is entered, the DATE, TIME ON, Band, Mode, QSL and |
|
# PWR fields are automatically filled like specified in the config file |
|
if ($qso[0] ne $workcall) { # callsign has been changed! |
|
|
|
# not a new callsign, but a GRID: Look up grid info and clear callsign |
|
# field. |
|
if ($qso[0] =~ /([A-Z]{2}[0-9]{2}[A-Z]{2}|[A-Z]{2}[0-9]{2})/) { |
|
&gridinfo($qso,$winfo,$wi,$wqsos,$editnr); |
|
$af = 1; |
|
$qso[0] = ""; |
|
next; |
|
} |
|
|
|
if ($qso[1] eq "") { # No date yet entered? |
|
$qso[1] = &getdate; # set $qso[1] to current date |
|
} |
|
if ($qso[2] eq "") { # No time entered so far |
|
$qso[2] = &gettime; # set $qso[2] to current GMT |
|
addstr($wi[2],0,0,$qso[2]); # write into window |
|
refresh($wi[2]); # display changes |
|
} |
|
if ($qso[4] eq "") {$qso[4] = $dband}; # initialize default band |
|
if ($qso[5] eq "") {$qso[5] = $dmode}; # initialize default mode |
|
if ($qso[8] eq "") { # QSL sent, default Q = Queue |
|
$qso[8] = $dqsls; } # but to make QSL-writing/printing |
|
# mode correct, use "Y" for Yes, |
|
# (sent) "Q" for "put in Queue" |
|
# and "N" for no. |
|
if ($qso[9] eq "") { $qso[9] = $dqslr; } # QSL received, default N |
|
if ($qso[10] eq "") { # RST sent to 59(9) |
|
if ($dmode =~ /CW|RTTY|PSK/) {$qso[10] = "599";} |
|
else {$qso[10] = "59"; } |
|
if ($serial) { |
|
if ($qso[14] == -1) { |
|
$qso[14] = $serial; |
|
} |
|
$qso[10] .= sprintf("%03d", $qso[14]); |
|
} |
|
} |
|
if ($qso[11] eq "") { # RST rcvd to 59(9) |
|
if ($dmode =~ /CW|RTTY|PSK/) {$qso[11] = "599";} |
|
else {$qso[11] = "59";} |
|
} |
|
if ($qso[12] eq '') { |
|
$qso[12] = $drem; |
|
} |
|
if ($qso[13] eq "") {$qso[13] = $dpwr; } |
|
for(my $c=0;$c < 14;$c++) { # Refresh all windows |
|
addstr($wi[$c],0,0,$qso[$c]); |
|
refresh($wi[$c]) |
|
} |
|
&callinfo($qso,$winfo,$wi,$wqsos, $editnr); # print name, dxcc, prev QSOs... |
|
} # new call ends here |
|
} # end of $af = 1 |
|
elsif ($af == 2) { |
|
$aw = &readw($wi,1,1,$qso,\$wlog, # Read Date ($_[1] -> only numbers) |
|
\$editnr, 1, 8); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$af = &jumpfield($af, 'p'); |
|
$aw=1; |
|
} |
|
} # end of $af=2 |
|
elsif ($af == 3) { |
|
$aw=&readw($wi,1,2,$qso,\$wlog, # Read Time On ($_[1] -> only numbers) |
|
\$editnr, 1, 4); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=3 |
|
elsif ($af == 4) { |
|
$aw = &readw($wi,1,3,$qso,\$wlog, # Read T off ($_[1] -> only numbers) |
|
\$editnr, 1, 4); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=4 |
|
elsif ($af == 5) { |
|
$aw=&readw($wi,4,4,$qso,\$wlog, # Read band ($_[1] -> numbers and .) |
|
\$editnr, 1, 4); |
|
$dband=$qso[4] if $qso[4] ne ""; # next QSO will be on same band |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=5 |
|
elsif ($af == 6) { |
|
$aw=&readw($wi,0,5,$qso,\$wlog, # Read mode |
|
\$editnr, 1, 5); |
|
$dmode=$qso[5] if $qso[5] ne ""; # next QSO will be on same mode |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=6 |
|
elsif ($af == 7) { |
|
$aw=&readw($wi,3,6,$qso,\$wlog, # read QTH |
|
\$editnr, 0, 13); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=7 |
|
elsif ($af == 8) { |
|
$aw=&readw($wi,3,7,$qso,\$wlog, # read Name |
|
\$editnr, 0, 8); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=8 |
|
elsif ($af == 9) { |
|
$aw=&readw($wi,2,8,$qso,\$wlog, # read QSLsent. All letters allowed, |
|
\$editnr, 1, 1); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=9 |
|
|
|
elsif ($af == 10) { |
|
$aw=&readw($wi,2,9,$qso,\$wlog, # QSL received |
|
\$editnr, 1, 1); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=10 |
|
|
|
elsif ($af == 11) { |
|
$aw=&readw($wi,1,10,$qso,\$wlog, # rst sent (and optional serial) |
|
\$editnr, 1, 7); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=11 |
|
|
|
elsif ($af == 12) { |
|
$aw=&readw($wi,1,11,$qso,\$wlog, # rst received |
|
\$editnr, 1, 7); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=12 |
|
elsif ($af == 13) { |
|
$aw=&readw($wi,3,12,$qso,\$wlog, # Remarks |
|
\$editnr, 0, 56); |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=13 |
|
|
|
elsif ($af == 14) { |
|
$aw=&readw($wi,1,13,$qso,\$wlog, # Power |
|
\$editnr, 1, 4); |
|
$dpwr=$qso[13] if ($qso[13] ne ''); # next QSO will be with same PWR |
|
if ($aw == 1) { # Normal exit. next field! |
|
$af = &jumpfield($af, 'n'); |
|
} |
|
elsif ($aw < 7) { # to another window or restart in $aw=1 |
|
next; # (when $aw=4) |
|
} |
|
elsif ($aw == 7) { # One window BACK |
|
$aw=1; |
|
$af = &jumpfield($af, 'p'); |
|
} |
|
} # end of $af=14 |
|
} # end of loop for input mode ($aw = 1) |
|
|
|
############################################################################## |
|
# Chose QSO in the Log Window, then edit. $wlog, $aw == 2 |
|
############################################################################## |
|
|
|
while ($aw == 2) { |
|
mycurs_set(0); # Make the cursor invisible |
|
|
|
# choseqso lets the OP scroll in the log and select a QSO. The return value |
|
# is the number of the QSO as in the NR column in the database |
|
$editnr = &choseqso(\$wlog); |
|
|
|
# $nr contains either the number of the QSO to fetch OR a "i" or "q" to |
|
# indicate the next window: |
|
|
|
if ($editnr eq "i") { # back to input window |
|
$aw = 1; # $active window = 1, input window |
|
$editnr = 0; # we don't edit anything |
|
} |
|
elsif ($editnr eq "q"){ # previous QSO window |
|
$aw = 3; |
|
$editnr = 0; # we don't edit anything |
|
} |
|
elsif ($editnr eq "m"){ # go to MAIN MENU |
|
$aw = 5; |
|
$editnr = 0; # we don't edit anything |
|
} |
|
else { # if we get here, we have a QSO number |
|
|
|
# now we fetch the info for the selected QSO from the database and save it |
|
# into the @qso-array. when we save the QSO |
|
# again in $aw = 1, it will not be saved as a new QSO but it will alter the |
|
# existing QSO because &saveqso; checks for an existing $editnr |
|
|
|
&clearinputfields($wi,1); # deletes all input fields |
|
my $snr = $qso[14]; # remember sent serial |
|
@qso = &getqso($editnr,$wi); |
|
$qso[14] = $snr; |
|
&callinfo($qso,$winfo,$wi,$wqsos, $editnr); |
|
$aw = 1; |
|
} |
|
} # end of loop for log-window ($wlog, $aw = 2) |
|
|
|
|
|
############################################################################## |
|
# Chose QSO in the prev-QSOs-Window, then edit. $wqsos, $aw == 3 |
|
############################################################################## |
|
|
|
while ($aw == 3) { |
|
mycurs_set(0); # Make the cursor invisible |
|
$editnr = &chosepqso(\$wqsos,$qso[0]); |
|
|
|
if ($editnr eq "i") { # back to input window |
|
$aw = 1; # $active window = 1, input window |
|
$editnr = 0; # we don't edit anything |
|
} |
|
elsif ($editnr eq "l"){ # log window |
|
$aw = 2; |
|
$editnr = 0; # we don't edit anything |
|
} |
|
elsif ($editnr eq "m") { # back to the main menu |
|
$aw = 5; # $active window = 5, -> MAIN MENU |
|
$editnr = 0; # we don't edit anything |
|
} |
|
else { # we have a QSO number now! |
|
|
|
# proceed like before. |
|
|
|
&clearinputfields($wi,1); # deletes all input fields |
|
my $snr = $qso[14]; # remember sent serial |
|
@qso = &getqso($editnr,$wi); # put QSO number $editnr in @qso |
|
$qso[14] = $snr; |
|
&callinfo($qso,$winfo,$wi,$wqsos,$editnr); # show callinfo |
|
$aw = 1; # go to edit window |
|
} |
|
} # end of $aw == 3 |
|
|
|
|
|
if ($aw == 4) { $aw = 1; } # we restarted the input window, F3 |
|
|
|
if ($aw == 5) { # we leave logging mode and go to menu! |
|
$aw = 1; # for the next time when we come here |
|
$status = 2; # we go to the menu! |
|
last; # leave this loop. |
|
} |
|
|
|
# F7 -> Check for QSO from fldigi; either until a QSO was received, or F7 was |
|
# pressed again. |
|
|
|
addstr($wqsos, 0, 0, ' 'x500); |
|
while ($aw == 6) { |
|
mycurs_set(0); |
|
halfdelay(10); |
|
|
|
addstr($wqsos, 0, 0, "Remote Log Mode. Listening for QSOs from fldigi."); |
|
addstr($wqsos, 1, 0, "Press F7 again to return to interactive mode."); |
|
refresh($wqsos); |
|
|
|
my $c = getch2(); |
|
my $ret = &receive_qso(); |
|
&lastqsos(\$wlog); |
|
|
|
if ($ret) { |
|
addstr($wqsos, 4, 0, "Received QSO: $ret "); |
|
} |
|
refresh($wqsos); |
|
|
|
if ($c eq KEY_F(7)) { |
|
addstr($wqsos, 0, 0, " "x500); |
|
refresh($wqsos); |
|
cbreak(); |
|
$aw = 1; |
|
next; |
|
} |
|
} |
|
|
|
|
|
} # end of main logging loop (while(1)) |
|
|
|
} # end of $status == 1 logging loop |
|
|
|
############################################################################## |
|
# MAIN MENU MODE $status = 2 |
|
############################################################################## |
|
|
|
while ($status == 2) { |
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(0); |
|
my $choice; # Choice from the main menu |
|
|
|
# These are the menu items to chose from in the main menu. |
|
my @menuitems = ("Logging Mode - Enter QSOs here", |
|
"Search and Edit - Searching and Editing QSOs.", |
|
"QSL write mode - Displays a list of queued QSL cards to write", |
|
"QSL print mode - Prints queued QSL cards into a pdf-File", |
|
"QSL enter mode - Quickly mark QSOs as 'QSL-received'", |
|
"ADIF Import - Import QSOs to current logbook", |
|
"ADIF Export - Export QSOs in ADIF Format", |
|
"Update Onlinelog - Update the online searchable log", |
|
"Select Logbook - Change active Logbook or create/delete new one", |
|
"Awards/Statistics - DXCC, WAZ, WPX, IOTA etc. plus statistics", |
|
"Edit Name/QTH DB - Edit the database used to save Names and QTHs", |
|
"Import from LoTW - Read LoTW report and update the confirmations", |
|
"Export to LoTW - Generate ADIF file of QSOs not uploaded yet", |
|
"Export QSL ADIF - Generate ADIF file of QSOs with QSL status 'Q'", |
|
"Setup YFKlog - Most logbook settings can be changed here", |
|
"DX cluster - Console for the DX cluster" |
|
); |
|
|
|
addstr($whead, 0,0, "YFKlog v$yfkver - Main Menu - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver"." "x30); |
|
addstr($whelp, 0,0, "Use the cursor keys to choose. F12 exits."." " x 70); |
|
refresh($whead); |
|
refresh($whelp); |
|
addstr($wmain, 0,0, " " x (80*($row-2))); # empty |
|
refresh($wmain); |
|
|
|
# A (scrollable) list appears, where you can select any menu item. It |
|
# returns the number of the item. |
|
$choice = &selectlist(\$wmain, 2, 5, 20, 70, \@menuitems); |
|
|
|
# This is a bit chaotic. Every Menu item has a correspondent main program |
|
# status ($status), but there is no relation between their numbers. |
|
|
|
if ($choice eq "m") { # F1 - > stay in menu |
|
} # do nothing |
|
elsif ($choice == 0) { # To logging mode |
|
$status = 1; # Set main status |
|
} |
|
elsif ($choice == 4) { # QSL receive mode |
|
$status = 3; # main status 3 |
|
} |
|
elsif ($choice == 7) { # Update Online Log |
|
$status = 4; # main status 4 |
|
} |
|
elsif ($choice == 2) { # QSL write mode |
|
$status = 5; # main status 5 |
|
} |
|
elsif ($choice == 3) { # QSL Print mode |
|
$status = 6; # main status 6 |
|
} |
|
elsif ($choice == 6) { # ADIF export |
|
$status = 7; # main status 7 |
|
} |
|
elsif ($choice == 1) { # Search and Edit Mode |
|
$status = 8; |
|
} |
|
elsif ($choice == 5) { # ADIF IMPORT |
|
$status = 9; |
|
} |
|
elsif ($choice == 8) { # Select log |
|
$status = 10; |
|
} |
|
elsif ($choice == 9) { # AWARD mode |
|
$status = 11; |
|
} |
|
elsif ($choice == 10) { # Name/QTH editor |
|
$status = 12; |
|
} |
|
elsif ($choice == 11) { # LoTW import |
|
$status = 13; |
|
} |
|
elsif ($choice == 12) { # LoTW export |
|
$status = 14; |
|
} |
|
elsif ($choice == 13) { # Queued QSL export |
|
$status = 15; |
|
} |
|
elsif ($choice == 14) { # Setup mode |
|
$status = 16; |
|
} |
|
elsif ($choice == 15) { # Setup DX cluster |
|
$status = 17; |
|
} |
|
|
|
} # end of $status == 2, Main menu |
|
|
|
|
|
############################################################################## |
|
# QSL RECEIVE MODE $status = 3 |
|
# In this mode you enter a callsign or a part of it, and all matching QSOs |
|
# are shown in a list. On this list you can toggle the QSL-received flags |
|
# quickly by pressing space-bar. F2 saves, F3 cancels, F1 goes back to the menu |
|
# and F12 exits |
|
############################################################################## |
|
|
|
while ($status == 3) { |
|
my $qslcall= ""; # The callsign from which we got a QSL |
|
my $validc = "[a-zA-Z0-9\/]"; # valid characters for the callsign |
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(1); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - QSL receive mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver"); |
|
addstr($whelp, 0,0, "Enter a call and select QSOs. F1 Main menu F2 Save F3 Cancel F12 Exit"." " x 70); |
|
refresh($whead); |
|
refresh($whelp); |
|
addstr($wmain, 0,0, " " x (80*($row-2))); # empty |
|
refresh($wmain); |
|
|
|
# We now ask for the callsign to search for... |
|
$qslcall = &askbox(10,20,4,40,$validc,"Enter a callsign (3+ letters)", ''); |
|
|
|
# $qslcall now has the callsign to search for. |
|
# if the value is "m" (produced by F1) or it's empty, we go back to the |
|
# main menu. |
|
|
|
if (($qslcall eq "m") or ($qslcall eq "")) { |
|
$status = 2; # status = 2 -> Menu |
|
} |
|
# We check if at least 3 letters were entered. There are no calls shorter |
|
# than this, and 2 or 1 call would return too many QSOs. |
|
elsif (length($qslcall) > 2) { |
|
addstr($wmain, 0,0, " " x (80*$row)); # wipe out window |
|
|
|
# Now we are ready to call &toggleqsl which will query the database for |
|
# the callsign(fragment) entered and let the user toggle the |
|
# QSL-received status of the QSOs. |
|
# The return value says what we do next: If F1 is pressed, back to the |
|
# main Menu (return 2), else stay in the QSL receive mode (return 3). |
|
|
|
addstr($whelp, 0,0, "F1: Menu F2: Save F3: Cancel SPACE: Toggle QSL-R S: Toggle QSL-S "." " x 70); |
|
refresh($whelp); |
|
|
|
$status = &toggleqsl(\$wmain, $qslcall, 0); |
|
|
|
refresh($wmain); |
|
} |
|
|
|
} # end of $status = 3, QSL receiving mode |
|
|
|
|
|
############################################################################## |
|
# UPDATE ONLINE LOG Updates the online log. |
|
# Writes the log info in ~-separated format into a file on the local |
|
# machine, and optionally uploads the log via FTP. |
|
# The columns of the exported data are specified in the configfile variable |
|
# "onlinedata". |
|
############################################################################## |
|
|
|
while ($status == 4) { |
|
my $nr; # Number of QSOs exported. |
|
my $choice; # choice where to save the log. |
|
my $ftp; # return value of &ftpupload |
|
my @menuitems = |
|
("FTP - Upload via FTP to the machine specified in the config file", |
|
"local - Save it in $mycall.log"); |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(0); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Updating Online Log - Active Logbook: \U$mycall"." " x 30); |
|
addstr($whelp, 0,0, "Update in progress ..."." " x 70); |
|
refresh($whead); |
|
refresh($whelp); |
|
addstr($wmain, 0,0, " " x (80*($row-2))); # empty |
|
refresh($wmain); |
|
|
|
$nr = &onlinelog(); |
|
|
|
addstr($wmain, 5, 5, "$nr QSOs exported to the online log"); |
|
addstr($wmain, 6, 5, "Please select where to store the online-log file."); |
|
refresh($wmain); |
|
|
|
$choice = &selectlist(\$wmain, 8, 3, 20, 74, \@menuitems); |
|
|
|
if ($choice eq "m") { # User pressed F1->back to menu |
|
$status = 2; # Menu status |
|
last; # leave while loop |
|
} |
|
elsif ($choice == 0) { # Save FTP |
|
$ftp = &ftpupload; # upload log. return success or error msg |
|
attron($wmain, COLOR_PAIR(4)); # fucked up by selectlist |
|
addstr($wmain, 0,0, " " x (80*($row-2))); # empty |
|
addstr($wmain, 10,20, $ftp); # show what ftpupload ret |
|
refresh($wmain); |
|
} |
|
|
|
$status = 2; |
|
|
|
&waitkey(); |
|
|
|
|
|
} # end of $status = 4, update of online log |
|
|
|
############################################################################## |
|
# QSL WRITE MODE $status = 5 |
|
# A list of all QSOs where the QSL-Sent flag is "Q" = Queued is shown. |
|
# On this list you can toggle the QSL-sent flags |
|
# quickly by pressing space-bar. F2 saves, F3 cancels, F1 goes back to the menu |
|
# and F12 exits |
|
############################################################################## |
|
|
|
while ($status == 5) { |
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(1); |
|
|
|
# change text in head and help lines ... |
|
addstr($whead, 0,0, "YFKlog v$yfkver - QSL write mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' 'x30); |
|
addstr($whelp, 0,0, "F1: Main Menu F2: Save F3: Cancel SPACE: Toggle QSL status"." " x 70); |
|
refresh($whelp); |
|
refresh($whead); |
|
|
|
# In toggleqsl all the work is done. It displays all queued QSOs and lets |
|
# you toggle them. It returns the status, which should be 2 for the main |
|
# menu. |
|
|
|
$status = &toggleqsl(\$wmain, "W", $qsldetails); |
|
} # end of QSL write mode, $status==5 |
|
|
|
############################################################################## |
|
# QSL Print mode. In this mode all QSLs marked to be in QSL queue (QSLS = Q) |
|
# will be printed into a LaTeX file which will be compiled into a pdf and then |
|
# the user can print it labels. Arbitrary label sizes are possible. |
|
############################################################################## |
|
|
|
while ($status == 6) { |
|
my $labeltype; # Saves filename of the label type we use. |
|
my @menuitems; # Label sizes to chose from |
|
my %printlabels; # will store all the labels to be printed |
|
my $tex; # will store the full LaTeX document |
|
my $filename; # file name where the QSLs will be saved |
|
my $startlabel; # number of label where we start... |
|
my ($date1, $date2, $daterange) = ('','','1'); |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(0); # Make the cursor invisble |
|
# change text in head and help lines ... |
|
addstr($whead, 0,0, "YFKlog v$yfkver - QSL print mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
|
|
addstr($wmain,0,0," "x(80*($row-2))); # clear main window |
|
|
|
# Ask for a date range... |
|
addstr($wmain, 1,15, 'If you like to specify a date-range, or only print'); |
|
addstr($wmain, 2,16, 'QSLs after a certain QSO number, enter the start'); |
|
addstr($wmain, 3,15,'number or date now. Otherwise leave the field empty.'); |
|
addstr($whelp, 0,0, 'Specify an export range ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); # cursor visible |
|
$date1 = &askbox(6, 15, 4, 50, '[0-9-]', |
|
"Specify start date (YYYY-MM-DD) or number:", ''); |
|
|
|
if ($date1 ne '') { # We have a start date, or number |
|
my $type=0; |
|
|
|
if ($date1 =~ /^[0-9]+$/) { # nr range |
|
$date2 = &askbox(12, 15, 4, 50, '[0-9]', |
|
"Specify stop number (empty = end):", ''); |
|
$type = 'nr'; |
|
} |
|
else { |
|
$date2 = &askbox(12, 15, 4, 50, '[0-9-]', |
|
"Specify stop date (YYYY-MM-DD):", ''); |
|
$type = 'date'; |
|
} |
|
|
|
if ($type eq 'date') { |
|
# Verify that the dates are valid. If not, back to main menu. |
|
unless (&checkdate($date1) && &checkdate($date2)) { |
|
addstr($wmain, 18,29, 'Sorry, invalid date(s)!'); |
|
addstr($whelp,0,0,'Press any key to go back to the menu.'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
$status = 2; |
|
&waitkey(); |
|
last; |
|
} |
|
# if the dates are valid, build a SQL String to put into the |
|
# database-query. |
|
else { |
|
$daterange = "DATE >= '$date1' AND DATE <= '$date2'"; |
|
} |
|
} |
|
else { |
|
$daterange = " NR >= '$date1' "; |
|
if ($date2) { |
|
$daterange .= " AND NR <= '$date2' "; |
|
} |
|
} |
|
} |
|
|
|
addstr($wmain, 0,0, " "x(80*($row-2))); |
|
addstr($wmain, 3,5, "All QSLs marked as queued in date range will be printed."); |
|
addstr($wmain, 4,5, "Please select a label size."); |
|
refresh($whelp); |
|
refresh($wmain); |
|
refresh($whead); |
|
|
|
# Now looking in the current directory for label files (.lab). Those will |
|
# be stored in an array |
|
|
|
my @labeltypes = <$prefix/share/yfklog/labels/*.lab>; |
|
|
|
# Every label-file is opened and the first line which contains the |
|
# description is read. The descriptions are stored into the @menuitems |
|
# array, plus the filename. |
|
|
|
my $a = 0; # counter |
|
foreach my $lab (@labeltypes) { # go through all label files |
|
open LAB, "$lab"; |
|
my $labeldescription = <LAB>; # first line contains descr |
|
$labeldescription =~ /^% (.+)$/; # get the description. |
|
$labeldescription = $1; |
|
$menuitems[$a] = "$labeldescription ($lab)"; |
|
close LAB; |
|
$a++; |
|
} |
|
|
|
# Show a selectable list of the menu items and let the user select one |
|
$labeltype = &selectlist(\$wmain, 10,5 ,$a+1,70, \@menuitems); |
|
attron($wmain, COLOR_PAIR(4)); # selectlist leaves attribs changed |
|
|
|
if ($labeltype eq "m") { # User pressed F1 -> back to main menu! |
|
$status = 2; # Set $status = 2 -> Menu |
|
last; # exit while loop |
|
} |
|
|
|
# We don't want a number but the filename of the style file, so we select |
|
# it from the menuitems string, which looks like: |
|
# "Label description (filename.lab)" - we only need the filename |
|
|
|
$menuitems[$labeltype] =~ /.+\((.+)\)/; |
|
$labeltype = $1; |
|
|
|
# Now ask the user at which label to start. If you printed a few labels on |
|
# a sheet before, it would be a pity to throw the remaining labels away. |
|
# If a value larger than the number of labels on one page is entered, it's |
|
# disregarded. |
|
# TODO maybe save the value of the last printed label, then next time when |
|
# printing automatically continue from that position. |
|
|
|
$startlabel = |
|
&askbox(10,10,5,60,"\\d","Enter start label! (Default is 1)", ''); |
|
|
|
if ($startlabel eq "m") { # back to the menu... |
|
$status = 2; |
|
last; |
|
} |
|
elsif ($startlabel eq '') { # default start at 1 (= 1st label) |
|
$startlabel = 1; |
|
} |
|
|
|
# &preparelabels returns a hash with the LaTeX sourcecode for all labels to |
|
# be printed (QSLS=Q). |
|
|
|
%printlabels = &preparelabels($labeltype, $daterange); |
|
|
|
unless (%printlabels) { # If there are no QSOs to print |
|
addstr($wmain, 0,0, " "x(80*($row-2))); |
|
addstr($wmain, 10,28, "No QSL Cards in queue!"); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
last; |
|
} |
|
|
|
# All labels are in %printlabels, in alphabetical order. The next step is |
|
# to put them together in a LaTeX document, it is done by &makelabels. |
|
# You can specify a start-label number for the first page, which is |
|
# useful to use up pages where only the first few labels have been printed |
|
|
|
$tex = &labeltex(\%printlabels, $labeltype, $startlabel); |
|
|
|
# the number of exported labels and pages will be shown |
|
|
|
addstr($wmain, 0,0, " " x (80*($row-2))); # delete window |
|
|
|
$tex =~ /(\d+) (\d+)$/; |
|
|
|
addstr($wmain, 5,23, "Generated $1 labels on $2 pages(s)."); |
|
|
|
$filename = "qsl-$mycall-".&getdate; # assemble filename for labels |
|
|
|
open TEX, ">/tmp/$filename.tex"; # save the LaTeX document |
|
print TEX $tex; |
|
close TEX; |
|
|
|
addstr($wmain, 6,15, "Written to /tmp/$filename.tex, now compiling.."); |
|
refresh($wmain); |
|
|
|
system("cd /tmp/ ; pdflatex /tmp/$filename.tex > /dev/null"); |
|
system("mv /tmp/$filename.pdf $directory"); |
|
addstr($wmain, 8,16, "Done! You can now open the file"); |
|
addstr($wmain, 9,25, "$directory/$filename.pdf"); |
|
addstr($wmain, 10,16, "in your favourite PDF Viewer and print it."); |
|
addstr($wmain, 11,16, "If you're happy with the results, choose OK, then "); |
|
addstr($wmain, 12,16, "the QSL status of the processed QSOs will be"); |
|
addstr($wmain, 13,16, "set to \"Y\"."); |
|
refresh($wmain); |
|
|
|
my @items = (" OK", "Cancel"); # Items for selection |
|
my $choice; # Choice variable... |
|
|
|
$choice = &selectlist(\$wmain, 15,37,2,6, \@items); |
|
|
|
if ($choice eq "0") { # OK, update log! |
|
# update QSLS=Q to QSLS=Y... |
|
my $nr = &emptyqslqueue; # returns nr of QSOs.. |
|
addstr($wmain, 19,16, "$nr QSOs updated. Press any key to continue!"); |
|
refresh($wmain); |
|
&waitkey(); |
|
} |
|
|
|
$status = 2; # back to the main menu |
|
|
|
} # end of QSL Printing mode, $status==6 |
|
|
|
############################################################################## |
|
# ADIF EXPORT MODE $status = 7 |
|
# LoTW ADIF export mode, $status = 14 |
|
# Queued QSL ADIF export mode, $status = 15 |
|
############################################################################## |
|
|
|
while (($status == 7) || ($status == 14) || ($status == 15)) { |
|
my $filename; # filename for the adif/lotw file |
|
my $nr; # number of exported QSOs |
|
my ($date1, $date2, $daterange) = ('','','1'); |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(1); # Make the cursor visble |
|
|
|
# change text in head and help lines ... |
|
|
|
addstr($whead, 0,0, "YFKlog v$yfkver - ADIF export mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30) if ($status == 7); |
|
|
|
addstr($whead, 0,0, "YFKlog v$yfkver - LoTW export mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30) if ($status == 14); |
|
|
|
addstr($whead, 0,0, "YFKlog v$yfkver - Queued QSL export mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30) if ($status == 15); |
|
|
|
addstr($whelp, 0,0, "Enter a filename to export. F1: Main Menu F12: Exit"." " x 70); |
|
addstr($wmain,0,0," "x(80*($row-2))); # clear main window |
|
refresh($whelp); |
|
refresh($wmain); |
|
refresh($whead); |
|
|
|
$filename = $directory."/".$mycall.".adi"; |
|
|
|
# Now ask the user for the name of the file. Allow all \w characters. |
|
$filename= |
|
&askbox(10, 15,4,50, 'filename', "Enter a filename (default $mycall.adi).", |
|
$filename); |
|
mycurs_set(0); |
|
|
|
if ($filename eq 'm') { # go back to the menu |
|
$status = 2; |
|
last; # go out of while loop |
|
} |
|
elsif ($filename eq "") { # no filename -> default |
|
$filename = $directory.'/'.$mycall.'.adi'; |
|
} |
|
elsif (!($filename =~ /[.]adi/i)) { # add extension if needed. |
|
$filename .= '.adi'; |
|
} |
|
|
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); |
|
|
|
# Ask for a date range... |
|
addstr($wmain, 1,15, 'If you like to specify a date-range, or only export'); |
|
addstr($wmain, 2,16, 'QSOs after a certain QSO number, enter the start'); |
|
addstr($wmain, 3,15,'number or date now. Otherwise leave the field empty.'); |
|
addstr($whelp, 0,0, 'Specify an export range ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); # cursor visible |
|
$date1 = &askbox(6, 15, 4, 50, '[0-9-]', |
|
"Specify start date (YYYY-MM-DD) or number:", ''); |
|
|
|
if ($date1 ne '') { # We have a start date, or number |
|
my $type=0; |
|
|
|
if ($date1 =~ /^[0-9]+$/) { # nr range |
|
$date2 = &askbox(12, 15, 4, 50, '[0-9]', |
|
"Specify stop number (empty = end):", ''); |
|
$type = 'nr'; |
|
} |
|
else { |
|
$date2 = &askbox(12, 15, 4, 50, '[0-9-]', |
|
"Specify stop date (YYYY-MM-DD):", ''); |
|
$type = 'date'; |
|
} |
|
|
|
if ($type eq 'date') { |
|
# Verify that the dates are valid. If not, back to main menu. |
|
unless (&checkdate($date1) && &checkdate($date2)) { |
|
addstr($wmain, 18,29, 'Sorry, invalid date(s)!'); |
|
addstr($whelp,0,0,'Press any key to go back to the menu.'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
$status = 2; |
|
&waitkey(); |
|
last; |
|
} |
|
# if the dates are valid, build a SQL String to put into the |
|
# database-query. |
|
else { |
|
$daterange = "DATE >= '$date1' AND DATE <= '$date2'"; |
|
} |
|
} |
|
else { |
|
$daterange = " NR >= '$date1' "; |
|
if ($date2) { |
|
$daterange .= " AND NR <= '$date2' "; |
|
} |
|
} |
|
} |
|
|
|
|
|
# Export the log to $filename |
|
$nr = &adifexport($filename, 'adif', $daterange) if ($status == 7); |
|
$nr = &adifexport($filename, 'lotw', $daterange) if ($status == 14); |
|
$nr = &adifexport($filename, 'queue', $daterange) if ($status == 15); |
|
|
|
# if the user was impatient and pressed enter, he will not see the |
|
# following screen, so flush the input buffer |
|
flushinp(); |
|
|
|
addstr($wmain,0,0, ' ' x (80*($row-2))); # clear main window |
|
addstr($wmain,10,10,"$nr QSOs exported to $filename"); |
|
|
|
if ($status == 14) { # LoTW |
|
addstr($wmain,11,22,"LoTW status updated to 'Requested'."); |
|
|
|
# check if there are any station locations set for $mycall |
|
|
|
my @lotwlocations = &getlotwlocations(); |
|
|
|
if (length(@lotwlocations)) { |
|
addstr($whelp, 0,0, 'LoTW upload...'.' 'x50); |
|
refresh($whelp); |
|
addstr($wmain,12,17,"Select station location for signing with tqsl!"); |
|
refresh($wmain); |
|
mycurs_set(0); |
|
unshift (@lotwlocations, " Cancel "); |
|
my $choice = &selectlist(\$wmain, 14,30,6,22, \@lotwlocations); |
|
attron($wmain, COLOR_PAIR(4)); |
|
mycurs_set(0); |
|
if ($choice ne "m" and $choice > 0) { |
|
addstr($wmain,0,0," "x(80*($row-2))); # clear main window |
|
my @ret = &tqslsign($filename, $lotwlocations[$choice]); |
|
if ($ret[0] == 0) { |
|
addstr($wmain,5,18, "Upload successful! LoTW output below:"); |
|
} |
|
else { |
|
attron($wmain, COLOR_PAIR(6)); |
|
addstr($wmain,5, 5, "Upload failed."); |
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($wmain,6, 5, "You should upload this file ($filename) manually since"); |
|
addstr($wmain,7, 5, "the QSOs are flagged as 'Sent' already."); |
|
} |
|
#shift @ret; |
|
my $line = 9; |
|
foreach (@ret) { |
|
my $l = $_; |
|
chomp($l); |
|
addstr($wmain, $line++, 2, ">".$l); |
|
} |
|
|
|
refresh($wmain); |
|
} |
|
else { |
|
addstr($wmain,12,17,"Sign $filename with tqsl and upload to LoTW!"); |
|
refresh($wmain); |
|
} |
|
} # no lotwlocations found |
|
else { |
|
addstr($wmain,12,17,"Sign $filename with tqsl and upload to LoTW!"); |
|
refresh($wmain); |
|
} |
|
} |
|
|
|
refresh($wmain); |
|
flushinp(); |
|
&waitkey(); |
|
|
|
$status = 2; |
|
} # end ADIF export mode, $status==7 |
|
|
|
############################################################################## |
|
# SEARCH AND EDIT MODE $status == 8 |
|
############################################################################## |
|
|
|
while ($status == 8) { |
|
my @qso; # This array will store a QSO while editing... |
|
my @sqso; # This array will store the search criteria in the same |
|
# format as a @qso. |
|
for (0 .. 25) { # initialize the array, so it is not undef |
|
$qso[$_] = ''; |
|
} |
|
|
|
# The @qso-array: 0=call 1=date 2=t_on 3=t_off 4=band 5=mode 6=QTH 7=name |
|
# 8=QSLS 9=QSLR 10=RSTS 11=RSTR 12=REMarks 13=PWR 14=DXCC 15=PFX 16=CONT |
|
# 17=ITUZ 18=CQZ 19=QSLINFO 20=IOTA 21=STATE 22=NR 23=QSLRL, 24=OP, 25=GRID |
|
|
|
my $aw=1; # The ActiveWindow. This can be 1 = $wedit or 2 = |
|
# $weditlog |
|
my $editnr=0; # the number of the QSO which is currently edited. |
|
my $posnr=1; # cursor position of last edited qso |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Search & Edit mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
erase($wedit); |
|
addstr($wedit,0,0, ' 'x(80*5)); |
|
addstr($wedit, 0,0, &entrymask(0)); # creates the input entry mask |
|
addstr($wedit, 1,0, &entrymask(1)); |
|
addstr($wedit, 2,0, &entrymask(2)); |
|
addstr($wedit, 3,0, &entrymask(3)); |
|
addstr($wedit, 4,0, &entrymask(4)); |
|
erase($weditlog); |
|
addstr($weditlog,0,0, ' 'x(80*($row-2))); |
|
refresh($weditlog); |
|
refresh($whelp); |
|
refresh($wedit); |
|
&clearinputfields($wi, 2); |
|
|
|
while (1) { # outer loop around while ($aw = x) |
|
|
|
############################################################################## |
|
# $aw = 1 -- Editing the @qso-array in the $wi-windows. |
|
############################################################################## |
|
|
|
while ($aw == 1) { |
|
mycurs_set(1); |
|
touchwin($weditlog); |
|
refresh($weditlog); |
|
addstr($whelp, 0,0, 'F1: Menu F2: Save changes F3: Cancel F4: Delete QSO F5: Search'.' 'x30); |
|
refresh($whelp); |
|
|
|
$aw = &editw($wi,0,0,\@qso, 0, 12); # Edit call |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,1,\@qso, 1, 8); # edit date |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,2,\@qso, 1, 4); # edit time_on |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,3,\@qso, 1, 4); # edit time_off |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,4,4,\@qso, 1, 4); # edit band |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,5,\@qso, 1, 5); # edit mode |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,3,6,\@qso, 0, 13); # edit qth |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,3,7,\@qso, 0, 8); # edit name |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,2,8,\@qso, 1, 1); # edit QSLs |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,2,9,\@qso, 1, 1); # edit QSLr |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,10,\@qso, 1, 7); # edit RSTs |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,11,\@qso, 1, 7); # edit RSTr |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,3,12,\@qso, 0, 55); # edit Remarks |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,13,\@qso, 1, 4); # edit PWR |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,14,\@qso, 0, 4); # edit DXCC |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,15,\@qso, 0, 8); # edit PFX |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,16,\@qso, 0, 2); # edit CONT |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,17,\@qso, 0, 2); # edit ITUZ |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,1,18,\@qso, 0, 2); # edit CQZ |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,19,\@qso, 0, 8); # edit QSLINFO |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,3,20,\@qso, 0, 6); # edit IOTA |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,21,\@qso, 0, 2); # edit STATE |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,23,\@qso, 1, 1); # edit QSLRL |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,24,\@qso, 0, 6); # edit OPERATOR |
|
if ($aw ne '1' ) { last; } |
|
$aw = &editw($wi,0,25,\@qso, 0, 6); # edit GRID |
|
if ($aw ne '1' ) { last; } |
|
} |
|
|
|
if ($aw eq 'm') { # back to menu |
|
$status = 2; |
|
last; # break out from while (1) loop |
|
} |
|
elsif ($aw == 0) { # back to QSO list |
|
$editnr = 0; |
|
$aw = 2; |
|
} |
|
|
|
############################################################################## |
|
# $aw = 2 -- Scrolling through the logbook; only display QSOs that are |
|
# matching the search criteria entered and saved in @qso. |
|
############################################################################## |
|
|
|
while ($aw == 2) { |
|
mycurs_set(0); # Make the cursor invisble |
|
addstr($whelp, 0,0, 'F3: Cancel, new Search SPACE/ENTER: Edit QSO'.' 'x30); |
|
refresh($whelp); |
|
|
|
@sqso = @qso unless @sqso; |
|
|
|
# We have selected search criteria in the QSO-array. Now display a |
|
# scrollable list with only the matching QSOs. The user selects one QSO, |
|
# the number of the QSO (as in the NR field in the database) is returned. |
|
# The cursor position is changed inside choseeditqso and remembered in |
|
# this loop. |
|
|
|
$editnr = &choseeditqso(\$weditlog, \@sqso, \$posnr); |
|
|
|
if ($editnr eq 'm') { # back to MAIN MENU |
|
$status = 2; |
|
$aw = 1; |
|
last; |
|
} |
|
# cancel search (c) |
|
elsif (($editnr eq 'c') || ($editnr == 0)) { |
|
for (0 .. 25) { # clear the QSO and if no results also |
|
$qso[$_] = ''; # sqso |
|
} |
|
@sqso = (); |
|
$posnr = 1; # forget last cursor position |
|
$aw = 1; # back to list |
|
} |
|
else { |
|
# get the QSO from the database and put the content into the edit |
|
# fields / windows. |
|
&clearinputfields($wi, 2); |
|
@qso = &geteditqso($editnr,\@wi); |
|
$aw = 1; |
|
} |
|
} # $aw=2 |
|
|
|
} # outer loop around while ($aw = x) |
|
|
|
} # end of Search and Edit mode, $status == 8 |
|
|
|
############################################################################## |
|
# ADIF IMPORT MODE $status == 9 |
|
############################################################################## |
|
|
|
while ($status == 9) { |
|
my @adifiles; |
|
my $adifdir; |
|
my $adifile; |
|
my $nr; # nr of imported QSOs |
|
my $err; # nr of errors during import |
|
my $war; # nr of warnings during import |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - ADIF import mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Select a directory. F1 to abort.'); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
|
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); |
|
$adifdir = &askbox(10, 5, 4, 70, 'filename', "Directory to search ". |
|
"for ADIF files:", $directory); |
|
mycurs_set(0); |
|
|
|
# Check if directory is valid and there are adif files |
|
|
|
unless (-e $adifdir) { |
|
addstr($wmain, 5,15, "$adifdir does not exist! Any key to continue."); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
next; |
|
} |
|
|
|
addstr($whelp, 0,0, "Select a ADIF file from $adifdir or F1 to quit"); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
addstr($wmain, 2,10, "Select a ADIF file from $adifdir to import!"); |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
@adifiles = <$adifdir/*.adi>; |
|
push(@adifiles, <$adifdir/*.ADI>); |
|
push(@adifiles, <$adifdir/*.adif>); |
|
push(@adifiles, <$adifdir/*.ADIF>); |
|
|
|
my $y = scalar(@adifiles); |
|
|
|
if ($y == 0) { |
|
addstr($wmain, 5,15, "No ADI-Files in $adifdir! Any key to continue."); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
next; |
|
} |
|
|
|
# If there are more than 20 ADIF files in the list, we make it scrollable, |
|
# with a fixed height of 20. |
|
|
|
if ($y > 15) { $y = 15; } |
|
|
|
$adifile = &selectlist(\$wmain, 4,15, $y ,50, \@adifiles); |
|
|
|
if ($adifile eq 'm') { # F1 pressed, go back to the menu |
|
$status = 2; |
|
last; |
|
} |
|
else { # we want to import $adifiles[$adifile] |
|
($nr, $err, $war) = &adifimport($adifiles[$adifile],$whelp); |
|
} |
|
|
|
attron($wmain, COLOR_PAIR(4)); # selectlist changed attributes |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
|
|
if ($nr > 0) { # OK, QSOs imported |
|
$adifiles[$adifile] =~ /([^\/]+)$/; |
|
my $basename = $1; |
|
addstr($wmain, 8,20, "QSOs processed: $nr. Successful: ".($nr-$err)); |
|
addstr($wmain, 11,6, "Errors: $err. See detailed information in ". |
|
"/tmp/$mycall-import-from-$basename.err") if $err; |
|
addstr($wmain, 12,5, "Warnings: $war. See detailed information in ". |
|
"/tmp/$mycall-import-from-$basename.err") if $war; |
|
} |
|
else { # No QSOs imported, huh? |
|
addstr($wmain, 7,10, "No QSOs imported. Possibly this file doesn't meet the ADIF"); |
|
addstr($wmain, 8,10, "specifications. Make sure there the header is terminated"); |
|
addstr($wmain, 9,10, "with <eoh>. If you think the file is OK, contact author."); |
|
} |
|
refresh($wmain); |
|
|
|
&waitkey(); |
|
|
|
$status = 2; # back to main menu |
|
|
|
} # end of $status = 9, ADIF Import Mode |
|
|
|
|
|
############################################################################## |
|
# Select log MODE $status == 10 |
|
############################################################################## |
|
|
|
while ($status == 10) { |
|
my @logs; # all log_{call}-tables in the database |
|
my $choice; # logbook which is chosen |
|
my $oldcall=$mycall; |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Select Log mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Choose one of the logs or create/delete a new one ..'.' 'x50); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
addstr($wmain, 2,7, 'Select an existing logbook or create a new log or destroy an old one!'); |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
@logs = &getlogs(); # get list of logbooks |
|
push(@logs, " Create new Logbook "); # add option to make new one |
|
@logs = sort @logs; |
|
push(@logs, " Delete Logbook "); # add option to make new one |
|
@logs = sort @logs; |
|
# After dorting, the " Create new Logbook " entry will be at the first |
|
# position because it starts with a whitespace. This is needed because the |
|
# case of creating a new logbook has to be treated different. |
|
|
|
my $max = $row - 9; |
|
|
|
# If there are more than 15 logs in the list, we make it scrollable, |
|
# with a fixed height of 15. |
|
my $y = scalar(@logs); |
|
if ($y > $max) { $y = $max; } |
|
|
|
$choice = &selectlist(\$wmain, 4,30, $y ,20, \@logs); |
|
|
|
# Now check what the user chosed: If it is the first entry, a new database |
|
# has to be created. Otherwise only the $mycall has to be changed. |
|
|
|
if ($choice eq "m") { # F1 pressed -> back to main menu |
|
$status = 2; |
|
last; |
|
} |
|
elsif ($choice == 0) { # first item -> create new log |
|
mycurs_set(1); # cursor visible |
|
# Ask for the name of the new logbook. |
|
my $new = &askbox(10, 15, 4, 50, '[a-zA-Z0-9/]', |
|
"Enter a name (callsign) for a new logbook:", ''); |
|
mycurs_set(0); # cursr invisible |
|
my $msg = &newlogtable($new); |
|
addstr($wmain, 15, (40-(length($msg." ($new)")/2)), $msg." ($new)"); |
|
if ($msg =~ /successfully/) { # new call OK |
|
$mycall = "\L$new"; # take it as MYCALL |
|
$mycall =~ s/\//_/g; # / -> _ |
|
&changemycall($mycall); # change $mycall also in yfksubs.pl |
|
} |
|
refresh($wmain); |
|
&waitkey(); |
|
} |
|
elsif ($choice == 1) { # second item -> delete old log |
|
mycurs_set(1); # cursor visible |
|
# Ask for the name to delete. |
|
my $old = &askbox(10, 15, 4, 50, '[a-zA-Z0-9/]', |
|
"Enter a name (callsign) to delete:", ''); |
|
mycurs_set(0); # cursr invisible |
|
my $msg = &oldlogtable($old); |
|
addstr($wmain, 15, (40-(length($msg." ($old)")/2)), $msg." ($old)"); |
|
addstr($wmain, 16,15,"Select another logbook before leave the log, tks!"); |
|
if ($msg =~ /successfully/) { # delete succefull |
|
} |
|
refresh($wmain); |
|
&waitkey(); |
|
} |
|
else { # change $mycall to selected log |
|
$mycall = $logs[$choice]; # Callsign is here |
|
$mycall =~ s/\//_/g; # change / to _ |
|
$mycall =~ tr/[A-Z]/[a-z]/; # make letters lowercase |
|
&changemycall($mycall); # change $mycall also in yfksubs.pl |
|
} |
|
|
|
if ($mycall ne $oldcall) { |
|
&changeconfig("mycall=$oldcall", "mycall=$mycall"); |
|
} |
|
|
|
$status = 2; |
|
} # end of $status = 10, logbook config |
|
|
|
############################################################################## |
|
# AWARD MODE - Calculates score for DXCC, WPX, WAZ, IOTA |
|
############################################################################## |
|
|
|
while ($status == 11) { |
|
my ($date1,$date2); # start and stop date for award range |
|
my $daterange='1'; # SQL string with start and end date |
|
my %result= ('a'=>'b'); # DXCCs, WAZ, etc. for each band. |
|
my %resultc = ('a'=>'b'); # same, but CFMed |
|
my %resultcp = ('a'=>'b'); # same, Paper QSL received |
|
my %resultcl = ('a'=>'b'); # same, LoTW received |
|
my $custom=''; # DOK, RDA... |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Award mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Select an award to generate statistics for ..'.' 'x50); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
# Menu Items |
|
my @menu = ('DXCC', 'PFX', 'CQZ', 'IOTA', 'STATE', 'GRID', |
|
'QSO / Bands', 'QSO / Continent', 'QSO / Mode', 'Xplanet', |
|
'Custom', 'QSL' |
|
); |
|
|
|
# Let the user select one of the awards |
|
my $choice = &selectlist(\$wmain, 4,30, 12 ,20, \@menu); |
|
attron($wmain, COLOR_PAIR(4)); |
|
|
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); |
|
|
|
# Custom award. Ask for award type/string |
|
if ($choice eq '10') { |
|
addstr($wmain, 2,17, 'Custom Award Mode. Please specify which string'); |
|
addstr($wmain, 3,16, 'to search for (see documentation for details):'); |
|
addstr($whelp, 0,0, 'Specify a custom award type ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); |
|
$custom = &askbox(6, 15, 4, 50, '[a-zA-Z0-9]', |
|
"Enter custom award string:", ''); |
|
} |
|
|
|
unless ($choice eq '9' || $choice eq '11') {# not for the Xplanet, QSLs |
|
# Ask for a date range... |
|
addstr($wmain, 2,17, 'If you like to specify a date-range, enter the'); |
|
addstr($wmain, 3,16, 'start date now. Otherwise leave the field empty.'); |
|
addstr($whelp, 0,0, 'Specify a date range ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); # cursor visible |
|
$date1 = &askbox(6, 15, 4, 50, '[0-9-]', |
|
"Specify start date (YYYY-MM-DD):", ''); |
|
|
|
unless ($date1 eq '') { # We have a start date, so ask for end date |
|
$date2 = &askbox(12, 15, 4, 50, '[0-9-]', |
|
"Specify stop date (YYYY-MM-DD):", ''); |
|
|
|
# Verify that the dates are valid. If not, back to main menu. |
|
unless (&checkdate($date1) && &checkdate($date2)) { |
|
addstr($wmain, 18,29, 'Sorry, invalid date(s)!'); |
|
addstr($whelp, 0,0, 'Press any key to go back to the menu.'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
$status = 2; |
|
&waitkey(); |
|
last; |
|
} |
|
# if the dates are valid, build a SQL String to put into the |
|
# database-query. |
|
else { |
|
$daterange = "DATE >= '$date1' AND DATE <= '$date2'"; |
|
} |
|
} # unless date1 is empty |
|
|
|
# limit bands for query |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); |
|
|
|
addstr($wmain, 2,17, 'The following bands will be considered, as set in'); |
|
addstr($wmain, 3,16, '~/.yfklog/config. You can add or remove bands now.'); |
|
addstr($whelp, 0,0, 'Specify bands ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); |
|
$bands = &askbox(6, 15, 4, 50, '[0-9. ]', "Limit to bands:", $bands); |
|
|
|
} # unless 9 or 11 |
|
|
|
unless ($choice eq '11') {# not for the QSLs |
|
# limit modes for query |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); |
|
|
|
addstr($wmain, 2,17, 'The following modes will be considered, as set in'); |
|
addstr($wmain, 3,16, '~/.yfklog/config. You can add or remove modes now.'); |
|
addstr($whelp, 0,0, 'Specify modes ..'.' 'x50); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); |
|
$modes = &askbox(6, 15, 4, 50, '[A-Za-z0-9 ]', "Limit to modes:", $modes); |
|
} # unless 11 |
|
|
|
mycurs_set(0); # cursor invisible |
|
|
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # clear window |
|
addstr($wmain, 2, 25, "$menu[$choice] Statistics for " . |
|
uc(join('/', split(/_/, $mycall))) . |
|
" in " . join(', ', split(/\s+/, $modes))); |
|
addstr($whelp, 0,0, "$menu[$choice] statistics".' 'x50); |
|
refresh($whelp); |
|
|
|
# Now we make the queries, dependent on the AWARD type we chose in $choice |
|
# There are different general award types. The easiest are DXCC, WAZ, WAS, |
|
# IOTA etc, where the query method is always the same, only the database |
|
# field is different. In the menu, those are choices 0 .. 4. |
|
|
|
my $filename; |
|
if (($choice <= 5) || $choice == 10) { |
|
|
|
# The result hash has bands as keys and nr of dxcc/iotas etc as |
|
# values. |
|
&awards($daterange,$menu[$choice], \%result, \%resultc, \%resultcp, |
|
\%resultcl, $bands, $modes, $custom); |
|
addstr($wmain, 5, 20, "Band Wkd Cfmd QSL LoTW"); |
|
my $y = 5; |
|
# Since "All" is not numeric and fucks up the sorting, we change it to |
|
# 9999 instead and change later. |
|
($result{'9999'}, $resultc{'9999'}) = ($result{'All'}, $resultc{'All'}); |
|
($resultcp{'9999'},$resultcl{'9999'})=($resultcp{'All'},$resultcl{'All'}); |
|
|
|
delete $result{'All'}; delete $resultc{'All'}; |
|
delete $resultcp{'All'}; delete $resultcl{'All'}; |
|
|
|
foreach my $key (sort {$a <=> $b} keys %result) { |
|
$y++; |
|
addstr($wmain, $y, 20, |
|
sprintf("%-4s %-4s %-4s %-4s %-4s" , |
|
$key, $result{$key}, $resultc{$key}, |
|
$resultcp{$key}, $resultcl{$key})); |
|
} |
|
addstr($wmain, $y, 20, sprintf("%-4s" ,"All")); # only overwrite 9999 with All |
|
|
|
addstr($wmain, $y+2,5, "Created detailed HTML-summary at $directory/$mycall-$menu[$choice].html"); |
|
} |
|
|
|
# For QSO / Continent and QSO / Band other queries have to be made... |
|
elsif ($choice =~ /[678]/) { |
|
if ($choice eq "6") { |
|
&statistics("BAND", \$wmain, $daterange, $bands, $modes);# result: BAND -> nr of QSOs |
|
$filename="BAND"; |
|
} |
|
elsif ($choice eq "7") { |
|
&statistics("CONT", \$wmain, $daterange, $bands, $modes);# result: CONT->nr of QSOs |
|
$filename="CONT"; |
|
} |
|
elsif ($choice eq "8") { |
|
&statistics("MODE", \$wmain, $daterange, $bands, $modes);# result: MODE ->nr of QSOs |
|
$filename="MODE"; |
|
} |
|
addstr($wmain, 20,5, "Created detailed HTML-summary at $directory/$mycall-$filename.html"); |
|
} |
|
elsif ($choice eq '9') { # Generate Marker file for xplanet |
|
&xplanet($modes); |
|
addstr($wmain, 8,5, "Output file $directory/$mycall-earth written."); |
|
} |
|
elsif ($choice eq '11') { |
|
&qslstatistics($wmain); |
|
} |
|
|
|
# Statistics printed, wait for keystroke to go back to the menu |
|
refresh($wmain); |
|
flushinp(); |
|
&waitkey(); |
|
|
|
$status = 2; # back to menu |
|
} # AWARD mode |
|
|
|
############################################################################## |
|
# Name and QTH database editor |
|
############################################################################## |
|
|
|
while ($status == 12) { |
|
my $call; # The callsign to edit. |
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Name/DB edit mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Enter the callsign to edit. F1: Menu F12: Quit'.' 'x50); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
mycurs_set(1); # cursor visible |
|
$call= &askbox(10, 30, 4, 20, '[a-zA-Z0-9]', "Enter a callsign:", ''); |
|
# Edit the entry; returns 2 when the user wants to go back to the menu, |
|
# otherwise 12. When the call is "m", go back to menu directly. |
|
unless ($call eq "m" || $call =~ /^[A-Z0-9]{0,2}$/) { |
|
addstr($whelp, 0,0, 'F1: Back to menu F2: Save F3: Delete entry'.' 'x50); |
|
refresh($whelp); |
|
$status = &editdb($call, \$wmain); |
|
} |
|
else { |
|
$status = 2; |
|
} |
|
} |
|
|
|
|
|
|
|
############################################################################## |
|
# LoTW IMPORT MODE $status == 13 |
|
############################################################################## |
|
|
|
while ($status == 13) { |
|
my @lotwfiles; |
|
my $lotwdir; |
|
my $lotwfile; |
|
my ($nr, $match, $updated, $nf); |
|
my @updates; |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - LoTW import mode - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Select source of LoTW file. F1 to abort.'); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
|
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
my @options = ('Open local file', 'Download from LoTW'); |
|
|
|
my $choice = &selectlist(\$wmain, 4,15, 10 , 50, \@options); |
|
attron($wmain, COLOR_PAIR(4)); |
|
|
|
if ($choice eq "m") { |
|
$status = 2; |
|
last; |
|
} |
|
elsif ($choice == 1) { # download automatically |
|
addstr($whelp,0,0, ' 'x(80*($row-2))); # blue background |
|
addstr($whelp, 0,0, "Trying to download LoTW report..."); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); |
|
addstr($wmain, 2,5, "Checking for newest LoTW confirmation to set the start date..."); |
|
refresh($wmain); |
|
refresh($whelp); |
|
|
|
my $startdate = &getlotwstartdate(); |
|
addstr($wmain, 3,5, "Using date: $startdate"); |
|
refresh($wmain); |
|
addstr($wmain, 4,5, "Attempting to download. This may take a while. Please wait..."); |
|
refresh($wmain); |
|
|
|
$lotwfile = &downloadlotw($startdate); |
|
|
|
if (!$lotwfile) { |
|
attron($wmain, COLOR_PAIR(6)); |
|
addstr($wmain,6, 5, "Download failed! Check username/password and/or network connection."); |
|
attron($wmain, COLOR_PAIR(4)); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
next; |
|
} |
|
|
|
flushinp(); |
|
|
|
} |
|
else { |
|
mycurs_set(1); |
|
$lotwdir = &askbox(10, 5, 4, 70, 'filename', "Directory to search ". |
|
"for LoTW files:", $directory); |
|
mycurs_set(0); |
|
|
|
# Check if directory is valid and there are ADIF files |
|
|
|
unless (-e $lotwdir) { |
|
addstr($wmain, 5,15, "$lotwdir does not exist! Any key to continue."); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
next; |
|
} |
|
|
|
addstr($whelp, 0,0, "Select a LoTW file from $lotwdir or F1 to quit"); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
addstr($wmain, 2,10, "Select a LoTW file from $lotwdir to import!"); |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
@lotwfiles = <$lotwdir/*.adi>; |
|
push(@lotwfiles, <$lotwdir/*.ADI>); |
|
push(@lotwfiles, <$lotwdir/*.ADIF>); |
|
push(@lotwfiles, <$lotwdir/*.adif>); |
|
my $y = scalar(@lotwfiles); |
|
|
|
if ($y == 0) { |
|
addstr($wmain, 5,15, "No ADI-Files in $lotwdir! Any key to continue."); |
|
refresh($wmain); |
|
&waitkey(); |
|
$status = 2; # back to main menu |
|
next; |
|
} |
|
|
|
# If there are more than 15 ADIF files in the list, we make it scrollable, |
|
# with a fixed height of 15. |
|
|
|
if ($y > 15) { $y = 15; } |
|
|
|
$lotwfile = &selectlist(\$wmain, 4,15, $y , 50, \@lotwfiles); |
|
$lotwfile = $lotwfiles[$lotwfile]; |
|
} # select file |
|
|
|
if ($lotwfile eq 'm') { # F1 pressed, go back to the menu |
|
$status = 2; |
|
last; |
|
} |
|
else { # we want to import $lotwfiles[$lotwfile] |
|
($nr,$match,$nf,@updates) = &lotwimport($lotwfile,$whelp) |
|
} |
|
|
|
attron($wmain, COLOR_PAIR(4)); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
|
|
if ($nr > 0) { # OK, QSOs imported |
|
$lotwfile =~ /([^\/]+)$/; |
|
my $basename = $1; |
|
addstr($wmain, 4,15, "QSOs processed: $nr. Matches: $match. Not found: $nf"); |
|
addstr($wmain, 5,5, "See /tmp/$mycall-LoTW-update-from-$basename.err for QSLs that were not found.") if $nf; |
|
|
|
&selectlist(\$wmain, 7, 15, $row-10, 55, \@updates); |
|
attron($wmain, COLOR_PAIR(4)); |
|
} |
|
else { # Nothing |
|
addstr($wmain, 7,10, "No QSLs imported. Possibly this file doesn't meet the LoTW"); |
|
addstr($wmain, 8,10, "specifications. "); |
|
addstr($wmain, 9,10, "If you think the file is OK, contact author."); |
|
&waitkey(); |
|
} |
|
refresh($wmain); |
|
|
|
$status = 2; # back to main menu |
|
|
|
} # end of $status = 13, LoTW import |
|
|
|
############################################################################## |
|
# SETUP MODE $status == 16 |
|
# All settings of the .yfklog config file can be set/modified here. This will |
|
# be the default mode at startup, when YFKlog cannot find a .yfklog file |
|
# anywhere. |
|
############################################################################## |
|
|
|
while ($status == 16) { |
|
attron($wmain, COLOR_PAIR(4)); |
|
addstr($whead, 0,0, "YFKlog v$yfkver - Setup - Active Logbook: ". |
|
"\U$mycall"." - DB: $dbname @ $dbserver".' ' x 30); |
|
addstr($whelp, 0,0, 'Select the value you want to change. F1: Back to Menu. F12: Exit.'.' 'x50); |
|
erase($wmain); |
|
addstr($wmain,0,0, ' 'x(80*($row-2))); # blue background |
|
addstr($wmain,0,10, 'Most settings of ~/.yfklog/config can be changed here.'); |
|
addstr($wmain,1,10, 'Please refer to the manual for further explanations.'); |
|
addstr($wmain, 2,30, 'YFKlog setup'); |
|
refresh($wmain); |
|
refresh($whead); |
|
refresh($whelp); |
|
|
|
my @setup = ( |
|
sprintf("mycall=%-15s - Your call sign", $mycall), |
|
sprintf("dbuser=%-15s - DB username (MySQL only)", $yfksubs::dbuser), |
|
sprintf("dbname=%-15s - DB name", $yfksubs::dbname), |
|
sprintf("dbpass=%-15s - DB password (MySQL only)", $yfksubs::dbpass), |
|
sprintf("dbserver=%-15s - DB server (MySQL), or 'sqlite' for SQLite", $yfksubs::dbserver), |
|
sprintf("dbport=%-15s - DB server port (MySQL only)", $yfksubs::dbport), |
|
sprintf("dband=%-15s - Default ham radio band", $dband), |
|
sprintf("dmode=%-15s - Default mode", $dmode), |
|
sprintf("dpwr=%-15s - Default output power", $dpwr), |
|
sprintf("dqsls=%-15s - Default QSL sent", $dqsls), |
|
sprintf("dqslr=%-15s - Default QSL received", $dqslr), |
|
sprintf("dqslsi=%-15s - Default QSL sent for ADIF import", $yfksubs::dqslsi), |
|
sprintf("lat=%-15s - Latitude, north positive", $yfksubs::lat1), |
|
sprintf("lon=%-15s - Longitude, west positive", $yfksubs::lon1), |
|
sprintf("awardbands=%-15s - Bands for awards", $yfksubs::bands), |
|
sprintf("awardmodes=%-15s - Modes for awards", $yfksubs::modes), |
|
sprintf("screenlayout=%-15s - Layout, 1 or 0 (requires restart to take eff.)", $yfksubs::screenlayout), |
|
sprintf("checklogs=%-15s - Other logs to check for QSOs", $yfksubs::checklogs), |
|
sprintf("hamlibaddr=%-15s - IP address of rigctld (default: localhost)", $yfksubs::hamlibaddr), |
|
sprintf("hamlibport=%-15s - Port number of rigctl (default: 4532)", $yfksubs::hamlibport), |
|
sprintf("autoqueryrig=%-15s - Query hamlib automatically?", $yfksubs::autoqueryrig), |
|
sprintf("operator=%-15s - Operator's callsign", $yfksubs::operator), |
|
sprintf("lotwdetails=%-15s - Include details from LoTW?", $yfksubs::lotwdetails), |
|
sprintf("directory=%-15s - Default directory (ADIF, etc)", $yfksubs::directory), |
|
sprintf("fieldorder=%-15s - Default entry field order", $yfksubs::fieldorder), |
|
sprintf("askme=%-15s - Ask for confirmations?", $yfksubs::askme), |
|
sprintf("logsort=%-15s - Sorting log by 'N'umber or 'C'hronological", $yfksubs::logsort), |
|
sprintf("prevsort=%-15s - Show previous QSOs by date 'A'sc or 'D'esc?", $yfksubs::prevsort), |
|
sprintf("browser=%-15s - Web browser to use for QRZ.com lookups", $yfksubs::browser), |
|
sprintf("colors=%-15s - Enable colors? [1/0] (requires restart)", $colors), |
|
sprintf("usehamdb=%-15s - Use Ham::Callsign::DB to fill data", $yfksubs::usehamdb), |
|
sprintf("qsldetails=%-15s - Show QSO details in QSL write mode?", $qsldetails), |
|
sprintf("drem=%-15s - Default QSO remarks value", $drem), |
|
sprintf("serial=%-15s - Sent Serial Nr. (0 = None)", $serial), |
|
sprintf("lotwlocation=%-15s - LoTW station locations", $yfksubs::lotwlocation), |
|
sprintf("dxchost=%-15s - DX cluster hostname", $yfksubs::dxchost), |
|
sprintf("dxcport=%-15s - DX cluster port", $yfksubs::dxcport), |
|
sprintf("dxccall=%-15s - DX cluster login call", $yfksubs::dxccall), |
|
sprintf("dxcmode=%-15s - DX cluster mode (B = bandmap, N = normal)", $yfksubs::dxcmode), |
|
sprintf("cursoron=%-15s - Cursor always visible (1/0)", $yfksubs::cursoron), |
|
sprintf("qrzuser=%-15s - QRZ.com user name", $yfksubs::qrzuser), |
|
sprintf("qrzpass=%-15s - QRZ.com password (NOT the API key)", $yfksubs::qrzpass) |
|
); |
|
|
|
my $choice = &selectlist(\$wmain, 2, 1, $row-6, 78, \@setup); |
|
|
|
if ($choice eq 'm') { # back to main menu |
|
&readconfig; |
|
&readsubconfig; |
|
&connectdb; |
|
$firstrun = 0; |
|
$status = 2; |
|
# endwin; |
|
&databaseupgrade(1); # 1 -> clear screen first |
|
&waitkey(); |
|
last; |
|
} |
|
|
|
|
|
my $original = ''; |
|
if ($choice == 0) { |
|
$original = "mycall=$mycall"; |
|
my $ret = &askbox(10,20,4,30, '[A-Za-z0-9\/]', "Enter new mycall", $mycall); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
$ret = lc($ret); |
|
$ret =~ s/\//_/g; |
|
&changeconfig($original, "mycall=$ret"); |
|
} |
|
} |
|
elsif ($choice == 1) { |
|
$original = "dbuser=$yfksubs::dbuser"; |
|
my $ret = &askbox(10,20,4,30, '\w', "Enter new dbuser", |
|
$yfksubs::dbuser); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dbuser=$ret"); |
|
} |
|
} |
|
elsif ($choice == 2) { |
|
$original = "dbname=$yfksubs::dbname"; |
|
my $ret = &askbox(10,20,4,30, '\w', "Enter new dbname", |
|
$yfksubs::dbname); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dbname=$ret"); |
|
} |
|
} |
|
elsif ($choice == 3) { |
|
$original = "dbpass=$yfksubs::dbpass"; |
|
my $ret = &askbox(10,20,4,30, '\w', "Enter new dbpass", |
|
$yfksubs::dbpass); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dbpass=$ret"); |
|
} |
|
} |
|
elsif ($choice == 4) { |
|
$original = "dbserver=$yfksubs::dbserver"; |
|
my $ret = &askbox(10,20,4,30, 'filename', "Enter new dbserver", |
|
$yfksubs::dbserver); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dbserver=$ret"); |
|
} |
|
} |
|
elsif ($choice == 5) { |
|
$original = "dbport=$yfksubs::dbport"; |
|
my $ret = &askbox(10,20,4,30, '\d', "Enter new dbport", |
|
$yfksubs::dbport); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dbport=$ret"); |
|
} |
|
} |
|
elsif ($choice == 6) { |
|
$original = "dband=$dband"; |
|
my $ret = &askbox(10,20,4,30, '\d', "Enter new dband", |
|
$dband); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dband=$ret"); |
|
} |
|
} |
|
elsif ($choice == 7) { |
|
$original = "dmode=$dmode"; |
|
my $ret = &askbox(10,20,4,30, '[A-Za-z0-9]', "Enter new dmode", |
|
$dmode); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dmode=$ret"); |
|
} |
|
} |
|
elsif ($choice == 8) { |
|
$original = "dpwr=$dpwr"; |
|
my $ret = &askbox(10,20,4,30, '\d', "Enter new dpwr", |
|
$dpwr); |
|
if ($ret eq 'm') { last } |
|
elsif ($ret ne '') { |
|
&changeconfig($original, "dpwr=$ret"); |
|
} |
|
} |
|
elsif ($choice == 9) { |
|
$original = "dqsls=$dqsls"; |
|
my $ret = & |