diff --git a/yfk b/yfk index 507ab73..f51a014 100755 --- a/yfk +++ b/yfk @@ -21,10 +21,10 @@ # 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 strict; # No shabby code beyond this point :) +use DBI; # Database interface +use Curses; +use Net::FTP; # upload of online log or backup # terminal size (will be queried later) our $col; @@ -34,56 +34,56 @@ $SIG{'WINCH'} = sub { &redraw(); }; -my $prefix="/usr"; +my $prefix="/usr"; if (-f './yfk' && -f './yfksubs.pl' && -f 'THANKS') { - # we're in the source directory, source the local copy - require "./yfksubs.pl"; + # we're in the source directory, source the local copy + require "./yfksubs.pl"; } else { - require "$prefix/share/yfklog/yfksubs.pl"; + require "$prefix/share/yfklog/yfksubs.pl"; } import yfksubs; -our $yfkver = '0.4.0'; # Program Version +our $yfkver = '0.4.0'; # Program Version our $VERSION = '0.4.0'; # XXX # 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 $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=15; # 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 $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=15; # 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 +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 + $qso[14] = -1; # serial number saved here; -1 means not set yet sub readconfig { @@ -91,36 +91,36 @@ 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 = )) { # 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; } +while (defined (my $line = )) { # 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! -curs_set(0); # cursor invisible +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! +curs_set(0); # cursor invisible getmaxyx($row, $col); $row-- if ($row % 2); # force even number of rows @@ -129,38 +129,38 @@ printw &splashscreen($yfkver); # Check if a config-file exists. Otherwise make one. if (&readconfig) { - $firstrun = 0; - $status = 2; + $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"; - } - + 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, @@ -222,34 +222,34 @@ our ($whead, $whelp, $winput, $winfo, $wlog, $wqsos, $wedit, $weditlog, $wmain); # 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 +$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 ############################################################################## # MAIN PROGRAM LOOP @@ -258,7 +258,7 @@ my $wi = \@wi; # Window reference # ($status = 3) ... ############################################################################## -while (1) { # Loop infinitely; most outer loop. +while (1) { # Loop infinitely; most outer loop. ############################################################################## @@ -268,24 +268,24 @@ while (1) { # Loop infinitely; most outer loop. # 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...) - +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 + "\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($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 +addstr($wqsos, 0,0, " "x($row*80)); # prev qsos window delete -&lastqsos(\$wlog); # Print last QSOs into $wlog window +&lastqsos(\$wlog); # Print last QSOs into $wlog window refresh($winfo); refresh($whead); @@ -298,269 +298,269 @@ refresh($wqsos); # to $wqsos (3) (previous QSOs). $aw is the active window. ############################################################################## -&qsotofields($qso,$wi,1); # fills 14 input field with QSO array +&qsotofields($qso,$wi,1); # fills 14 input field with QSO array -# Now we loop infinitely until we get out of logging mode ($status==1) +# 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 - curs_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! - 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 + +$af = 1; # start in 1st field (call) + +while ($aw == 1) { # We are in the logging Window + curs_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! + 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; - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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'); - } + $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) @@ -569,42 +569,42 @@ elsif ($af == 14) { ############################################################################## while ($aw == 2) { - curs_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) + curs_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) ############################################################################## @@ -612,41 +612,41 @@ while ($aw == 2) { ############################################################################## while ($aw == 3) { - curs_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 - } + curs_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 == 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. +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 @@ -654,29 +654,29 @@ if ($aw == 5) { # we leave logging mode and go to menu! addstr($wqsos, 0, 0, ' 'x500); while ($aw == 6) { - curs_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 = getch(); - 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; - } + curs_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 = getch(); + 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; + } } @@ -688,20 +688,20 @@ while ($aw == 6) { # MAIN MENU MODE $status = 2 ############################################################################## -while ($status == 2) { +while ($status == 2) { attron($wmain, COLOR_PAIR(4)); - curs_set(0); - my $choice; # Choice from the main menu + curs_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", + # 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", + "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", @@ -709,67 +709,67 @@ while ($status == 2) { "Export to LoTW - Generate ADIF file of QSOs not uploaded yet", "Setup YFKlog - Most logbook settings can be changed here" ); - - 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) { # Setup mode - $status = 15; - } - + + 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) { # Setup mode + $status = 15; + } + } # end of $status == 2, Main menu @@ -781,48 +781,48 @@ while ($status == 2) { # 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)); - curs_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); - } - +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)); + curs_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 @@ -834,50 +834,50 @@ while ($status == 3) { # "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)); - curs_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; - - getch(); - - +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)); + curs_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; + + getch(); + + } # 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. @@ -887,21 +887,21 @@ while ($status == 4) { ############################################################################## while ($status == 5) { - attron($wmain, COLOR_PAIR(4)); - curs_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); + attron($wmain, COLOR_PAIR(4)); + curs_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 ############################################################################## @@ -911,197 +911,197 @@ while ($status == 5) { ############################################################################## 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)); - curs_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); - - curs_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; - getch(); - 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 = ; # 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); - getch(); - $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 + 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)); + curs_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); + + curs_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; + getch(); + 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 = ; # 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); + getch(); + $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); - getch(); - } - - $status = 2; # back to the main menu - + # 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); + getch(); + } + + $status = 2; # back to the main menu + } # end of QSL Printing mode, $status==6 ############################################################################## @@ -1110,139 +1110,139 @@ while ($status == 6) { ############################################################################## while (($status == 7) || ($status == 14)) { - my $filename; # filename for the adif/lotw file - my $nr; # number of exported QSOs - my ($date1, $date2, $daterange) = ('','','1'); - - attron($wmain, COLOR_PAIR(4)); - curs_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($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); - curs_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); - - curs_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; - getch(); - 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); + my $filename; # filename for the adif/lotw file + my $nr; # number of exported QSOs + my ($date1, $date2, $daterange) = ('','','1'); + + attron($wmain, COLOR_PAIR(4)); + curs_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($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); + curs_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); + + curs_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; + getch(); + 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); # 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"); + 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'."); + addstr($wmain,11,22,"LoTW status updated to 'Requested'."); # check if there are any station locations set for $mycall my @lotwlocations = &getlotwlocations(); if ($#lotwlocations) { - addstr($whelp, 0,0, 'LoTW upload...'.' 'x50); + addstr($whelp, 0,0, 'LoTW upload...'.' 'x50); refresh($whelp); - addstr($wmain,12,17,"Select station location for signing with tqsl!"); + addstr($wmain,12,17,"Select station location for signing with tqsl!"); refresh($wmain); - curs_set(0); + curs_set(0); unshift (@lotwlocations, " Cancel "); - my $choice = &selectlist(\$wmain, 14,30,6,22, \@lotwlocations); - attron($wmain, COLOR_PAIR(4)); - curs_set(0); + my $choice = &selectlist(\$wmain, 14,30,6,22, \@lotwlocations); + attron($wmain, COLOR_PAIR(4)); + curs_set(0); if ($choice ne "m" and $choice > 0) { - addstr($wmain,0,0," "x(80*($row-2))); # clear main window + 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)); + attron($wmain, COLOR_PAIR(6)); addstr($wmain,5, 5, "Upload failed."); - attron($wmain, COLOR_PAIR(4)); + 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."); } @@ -1257,21 +1257,21 @@ while (($status == 7) || ($status == 14)) { refresh($wmain); } else { - addstr($wmain,12,17,"Sign $filename with tqsl and upload to LoTW!"); + 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!"); + addstr($wmain,12,17,"Sign $filename with tqsl and upload to LoTW!"); refresh($wmain); } } - refresh($wmain); + refresh($wmain); flushinp(); - getch(); - - $status = 2; + getch(); + + $status = 2; } # end ADIF export mode, $status==7 ############################################################################## @@ -1279,111 +1279,111 @@ while (($status == 7) || ($status == 14)) { ############################################################################## 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[$_] = ''; - } + 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) - + + 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) { - curs_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; } + curs_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 +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; +elsif ($aw == 0) { # back to QSO list + $editnr = 0; + $aw = 2; } ############################################################################## @@ -1392,41 +1392,41 @@ elsif ($aw == 0) { # back to QSO list ############################################################################## while ($aw == 2) { - curs_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; - } + curs_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) @@ -1438,100 +1438,100 @@ while ($aw == 2) { ############################################################################## 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); - - curs_set(1); - $adifdir = &askbox(10, 5, 4, 70, 'filename', "Directory to search ". - "for ADIF files:", $directory); - curs_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); - getch(); - $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); - getch; - $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 . If you think the file is OK, contact author."); - } - refresh($wmain); - - getch(); - - $status = 2; # back to main menu + 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); + + curs_set(1); + $adifdir = &askbox(10, 5, 4, 70, 'filename', "Directory to search ". + "for ADIF files:", $directory); + curs_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); + getch(); + $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); + getch; + $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 . If you think the file is OK, contact author."); + } + refresh($wmain); + + getch(); + + $status = 2; # back to main menu } # end of $status = 9, ADIF Import Mode @@ -1541,88 +1541,88 @@ while ($status == 9) { ############################################################################## 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 @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 - curs_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:", ''); - curs_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); - getch(); - } - elsif ($choice == 1) { # second item -> delete old log - curs_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:", ''); - curs_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); - getch(); - } - 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; + # 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 + curs_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:", ''); + curs_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); + getch(); + } + elsif ($choice == 1) { # second item -> delete old log + curs_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:", ''); + curs_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); + getch(); + } + 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 ############################################################################## @@ -1630,185 +1630,185 @@ while ($status == 10) { ############################################################################## 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); - - curs_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); - - curs_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; - getch(); - 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); - - curs_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); - - curs_set(1); - $modes = &askbox(6, 15, 4, 50, '[A-Za-z0-9 ]', "Limit to modes:", $modes); - } # unless 11 - - curs_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); - getch(); - - $status = 2; # back to menu + 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); + + curs_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); + + curs_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; + getch(); + 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); + + curs_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); + + curs_set(1); + $modes = &askbox(6, 15, 4, 50, '[A-Za-z0-9 ]', "Limit to modes:", $modes); + } # unless 11 + + curs_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); + getch(); + + $status = 2; # back to menu } # AWARD mode ############################################################################## @@ -1816,29 +1816,29 @@ while ($status == 11) { ############################################################################## 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); - - curs_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; - } + 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); + + curs_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; + } } @@ -1848,34 +1848,34 @@ while ($status == 12) { ############################################################################## while ($status == 13) { - my @lotwfiles; - my $lotwdir; - my $lotwfile; - my ($nr, $match, $updated, $nf); + 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 + 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); + refresh($wmain); + refresh($whead); + refresh($whelp); my @options = ('Open local file', 'Download from LoTW'); - my $choice = &selectlist(\$wmain, 4,15, 10 , 50, \@options); + my $choice = &selectlist(\$wmain, 4,15, 10 , 50, \@options); attron($wmain, COLOR_PAIR(4)); if ($choice eq "m") { - $status = 2; - last; + $status = 2; + last; } elsif ($choice == 1) { # download automatically - addstr($whelp,0,0, ' 'x(80*($row-2))); # blue background + 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))); @@ -1892,12 +1892,12 @@ while ($status == 13) { $lotwfile = &downloadlotw($startdate); if (!$lotwfile) { - attron($wmain, COLOR_PAIR(6)); + 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); getch(); - $status = 2; # back to main menu + $status = 2; # back to main menu next; } @@ -1916,13 +1916,13 @@ while ($status == 13) { addstr($wmain, 5,15, "$lotwdir does not exist! Any key to continue."); refresh($wmain); getch(); - $status = 2; # back to main menu + $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,0,0, ' 'x(80*($row-2))); # blue background addstr($wmain, 2,10, "Select a LoTW file from $lotwdir to import!"); refresh($wmain); refresh($whead); @@ -1938,7 +1938,7 @@ while ($status == 13) { addstr($wmain, 5,15, "No ADI-Files in $lotwdir! Any key to continue."); refresh($wmain); getch; - $status = 2; # back to main menu + $status = 2; # back to main menu next; } @@ -1951,36 +1951,36 @@ while ($status == 13) { $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) - } + 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 + 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; + 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."); - getch(); - } + 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."); + getch(); + } refresh($wmain); - $status = 2; # back to main menu + $status = 2; # back to main menu } # end of $status = 13, LoTW import @@ -1992,394 +1992,394 @@ while ($status == 13) { ############################################################################## while ($status == 15) { - 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("rigmodel=%-15s - hamlib rig model number (0 = disable hamlib)", $yfksubs::rigmodel), - sprintf("rigpath=%-15s - hamlib rig path (e.g. /dev/ttyS0)", $yfksubs::rigpath), - 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'umer 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) - ); - - my $choice = &selectlist(\$wmain, 2, 1, $row-6, 78, \@setup); - - if ($choice eq 'm') { # back to main menu - &readconfig; - &readsubconfig; - &connectdb; - &connectrig; - $firstrun = 0; - $status = 2; -# endwin; - &databaseupgrade(1); # 1 -> clear screen first - getch; - 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 = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqsls", - $dqsls); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "dqsls=$ret"); - } - } - elsif ($choice == 10) { - $original = "dqslr=$dqslr"; - my $ret = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqslr", - $dqslr); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "dqslr=$ret"); - } - } - elsif ($choice == 11) { - $original = "dqslsi=$yfksubs::dqslsi"; - my $ret = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqslsi", - $yfksubs::dqslsi); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "dqslsi=$ret"); - } - } - elsif ($choice == 12) { - $original = "lat=$yfksubs::lat1"; - my $ret = &askbox(10,20,4,30, '[0-9\-]', "Enter new latitude", - $yfksubs::lat1); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "lat=$ret"); - } - } - elsif ($choice == 13) { - $original = "lon=$yfksubs::lon1"; - my $ret = &askbox(10,20,4,30, '[0-9\-]', "Enter new longitude", - $yfksubs::lon1); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "lon=$ret"); - } - } - elsif ($choice == 14) { - $original = "awardbands=$yfksubs::bands"; - my $ret = &askbox(10,20,4,50, '[0-9. ]', "Enter new award bands", - $yfksubs::bands); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "awardbands=$ret"); - } - } - elsif ($choice == 15) { - $original = "awardmodes=$yfksubs::modes"; - my $ret = &askbox(10,20,4,50, '[A-Z0-9. ]', "Enter new award modes", - $yfksubs::modes); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "awardmodes=$ret"); - } - } - elsif ($choice == 16) { - $original = "screenlayout=$yfksubs::screenlayout"; - my $ret = &askbox(10,20,4,30, '[10]', "Enter screenlayout (0 or 1)", - $yfksubs::screenlayout); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "screenlayout=$ret"); - } - } - elsif ($choice == 17) { - $original = "checklogs=$yfksubs::checklogs"; - my $ret = &askbox(10,20,4,30, '[A-Za-z0-9\/ ]', - "Enter checklogs (space separated)", - $yfksubs::checklogs); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "checklogs=$ret"); - } - } - elsif ($choice == 18) { - $original = "rigmodel=$yfksubs::rigmodel"; - my $ret = &askbox(10,20,4,30, '\d', "Enter hamlib rigmodel (0=no rig)", - $yfksubs::rigmodel); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "rigmodel=$ret"); - } - } - elsif ($choice == 19) { - $original = "rigpath=$yfksubs::rigpath"; - my $ret = &askbox(10,20,4,30, 'filename', "Enter hamlib rigpath", - $yfksubs::rigpath); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "rigpath=$ret"); - } - } - elsif ($choice == 20) { - $original = "autoqueryrig=$yfksubs::autoqueryrig"; - my $ret = &askbox(10,20,4,30, '[01]', "autoqueryrig? 1=yes, 0=no", - $yfksubs::autoqueryrig); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "autoqueryrig=$ret"); - } - } - elsif ($choice == 21) { - $original = "operator=$yfksubs::operator"; - my $ret = &askbox(10,20,4,30, '[a-zA-Z0-9]', "Enter new operator call", - $yfksubs::operator); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "operator=$ret"); - } - } - elsif ($choice == 22) { - $original = "lotwdetails=$yfksubs::lotwdetails"; - my $ret = &askbox(10,20,4,30, '[01]', "lotwdetails? 1=yes, 0=no", - $yfksubs::lotwdetails); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "lotwdetails=$ret"); - } - } - elsif ($choice == 23) { - $original = "directory=$yfksubs::directory"; - my $ret = &askbox(10,20,4,30, 'filename', "Default directory", - $yfksubs::directory); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "directory=$ret"); - } - } - elsif ($choice == 24) { - $original = "fieldorder=$yfksubs::fieldorder"; - my $ret = &askbox(10,20,4,30, '[A-Z ]', "Field order?", - $yfksubs::fieldorder); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "fieldorder=$ret"); - } - } - elsif ($choice == 25) { - $original = "askme=$yfksubs::askme"; - my $ret = &askbox(10,10,4,60, '[01]', - "Ask for confirmations (see Manual)? (0/1)", $yfksubs::askme); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "askme=$ret"); - } - } - elsif ($choice == 26) { - $original = "logsort=$yfksubs::logsort"; - my $ret = &askbox(10,10,4,60, '[ncNC]', - "Sort log by N=Number or C=Chronological?", $yfksubs::logsort); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - $ret = uc($ret); - &changeconfig($original, "logsort=$ret"); - } - } - elsif ($choice == 27) { - $original = "prevsort=$yfksubs::prevsort"; - my $ret = &askbox(10,10,4,60, '[ADad]', - "Sort prev. QSOs A=Ascending, D=Descending?", $yfksubs::prevsort); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - $ret = uc($ret); - &changeconfig($original, "prevsort=$ret"); - } - } - elsif ($choice == 28) { - $original = "browser=$yfksubs::browser"; - my $ret = &askbox(10,10,4,60, 'filename', - "Web browser for QRZ lookups?", $yfksubs::browser); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "browser=$ret"); - } - } - elsif ($choice == 29) { - $original = "colors=$colors"; - my $ret = &askbox(10,10,4,60, '[10]', - "Use colors? [1/0]", $colors); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "colors=$ret"); - } - } - elsif ($choice == 30) { - $original = "usehamdb=$yfksubs::usehamdb"; - my $ret = &askbox(10,20,4,30, '[01]', "Use Ham::Callsign::DB? 1=yes, 0=no", - $yfksubs::usehamdb); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "usehamdb=$ret"); - } - } - elsif ($choice == 31) { - $original = "qsldetails=$qsldetails"; - my $ret = &askbox(10,20,4,30, '[01]', "Show QSO details? 1=yes, 0=no", - $qsldetails); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "qsldetails=$ret"); - } - } - elsif ($choice == 32) { - $original = "drem=$drem"; - my $ret = &askbox(10,20,4,30, 'text', "Default remarks text?", - $drem); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "drem=$ret"); - } - } - elsif ($choice == 33) { - $original = "serial=$serial"; - my $ret = &askbox(10,20,4,30, 'text', "Default serial nr. (0 = none)?", - $serial); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "serial=$ret"); - } - } - elsif ($choice == 34) { # todo: askbox doesn't scroll beyond initial size - $original = "lotwlocation=$yfksubs::lotwlocation"; - my $ret = &askbox(10,5,4,70, '[A-Za-z0-9\-\/_,:]', "LoTW station locations?", $yfksubs::lotwlocation); - if ($ret eq 'm') { last } - elsif ($ret ne '') { - &changeconfig($original, "lotwlocation=$ret"); - } - } - &readconfig; - &readsubconfig; + 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("rigmodel=%-15s - hamlib rig model number (0 = disable hamlib)", $yfksubs::rigmodel), + sprintf("rigpath=%-15s - hamlib rig path (e.g. /dev/ttyS0)", $yfksubs::rigpath), + 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'umer 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) + ); + + my $choice = &selectlist(\$wmain, 2, 1, $row-6, 78, \@setup); + + if ($choice eq 'm') { # back to main menu + &readconfig; + &readsubconfig; + &connectdb; + &connectrig; + $firstrun = 0; + $status = 2; +# endwin; + &databaseupgrade(1); # 1 -> clear screen first + getch; + 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 = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqsls", + $dqsls); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "dqsls=$ret"); + } + } + elsif ($choice == 10) { + $original = "dqslr=$dqslr"; + my $ret = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqslr", + $dqslr); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "dqslr=$ret"); + } + } + elsif ($choice == 11) { + $original = "dqslsi=$yfksubs::dqslsi"; + my $ret = &askbox(10,20,4,30, '[A-Za-z]', "Enter new dqslsi", + $yfksubs::dqslsi); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "dqslsi=$ret"); + } + } + elsif ($choice == 12) { + $original = "lat=$yfksubs::lat1"; + my $ret = &askbox(10,20,4,30, '[0-9\-]', "Enter new latitude", + $yfksubs::lat1); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "lat=$ret"); + } + } + elsif ($choice == 13) { + $original = "lon=$yfksubs::lon1"; + my $ret = &askbox(10,20,4,30, '[0-9\-]', "Enter new longitude", + $yfksubs::lon1); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "lon=$ret"); + } + } + elsif ($choice == 14) { + $original = "awardbands=$yfksubs::bands"; + my $ret = &askbox(10,20,4,50, '[0-9. ]', "Enter new award bands", + $yfksubs::bands); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "awardbands=$ret"); + } + } + elsif ($choice == 15) { + $original = "awardmodes=$yfksubs::modes"; + my $ret = &askbox(10,20,4,50, '[A-Z0-9. ]', "Enter new award modes", + $yfksubs::modes); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "awardmodes=$ret"); + } + } + elsif ($choice == 16) { + $original = "screenlayout=$yfksubs::screenlayout"; + my $ret = &askbox(10,20,4,30, '[10]', "Enter screenlayout (0 or 1)", + $yfksubs::screenlayout); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "screenlayout=$ret"); + } + } + elsif ($choice == 17) { + $original = "checklogs=$yfksubs::checklogs"; + my $ret = &askbox(10,20,4,30, '[A-Za-z0-9\/ ]', + "Enter checklogs (space separated)", + $yfksubs::checklogs); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "checklogs=$ret"); + } + } + elsif ($choice == 18) { + $original = "rigmodel=$yfksubs::rigmodel"; + my $ret = &askbox(10,20,4,30, '\d', "Enter hamlib rigmodel (0=no rig)", + $yfksubs::rigmodel); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "rigmodel=$ret"); + } + } + elsif ($choice == 19) { + $original = "rigpath=$yfksubs::rigpath"; + my $ret = &askbox(10,20,4,30, 'filename', "Enter hamlib rigpath", + $yfksubs::rigpath); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "rigpath=$ret"); + } + } + elsif ($choice == 20) { + $original = "autoqueryrig=$yfksubs::autoqueryrig"; + my $ret = &askbox(10,20,4,30, '[01]', "autoqueryrig? 1=yes, 0=no", + $yfksubs::autoqueryrig); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "autoqueryrig=$ret"); + } + } + elsif ($choice == 21) { + $original = "operator=$yfksubs::operator"; + my $ret = &askbox(10,20,4,30, '[a-zA-Z0-9]', "Enter new operator call", + $yfksubs::operator); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "operator=$ret"); + } + } + elsif ($choice == 22) { + $original = "lotwdetails=$yfksubs::lotwdetails"; + my $ret = &askbox(10,20,4,30, '[01]', "lotwdetails? 1=yes, 0=no", + $yfksubs::lotwdetails); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "lotwdetails=$ret"); + } + } + elsif ($choice == 23) { + $original = "directory=$yfksubs::directory"; + my $ret = &askbox(10,20,4,30, 'filename', "Default directory", + $yfksubs::directory); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "directory=$ret"); + } + } + elsif ($choice == 24) { + $original = "fieldorder=$yfksubs::fieldorder"; + my $ret = &askbox(10,20,4,30, '[A-Z ]', "Field order?", + $yfksubs::fieldorder); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "fieldorder=$ret"); + } + } + elsif ($choice == 25) { + $original = "askme=$yfksubs::askme"; + my $ret = &askbox(10,10,4,60, '[01]', + "Ask for confirmations (see Manual)? (0/1)", $yfksubs::askme); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "askme=$ret"); + } + } + elsif ($choice == 26) { + $original = "logsort=$yfksubs::logsort"; + my $ret = &askbox(10,10,4,60, '[ncNC]', + "Sort log by N=Number or C=Chronological?", $yfksubs::logsort); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + $ret = uc($ret); + &changeconfig($original, "logsort=$ret"); + } + } + elsif ($choice == 27) { + $original = "prevsort=$yfksubs::prevsort"; + my $ret = &askbox(10,10,4,60, '[ADad]', + "Sort prev. QSOs A=Ascending, D=Descending?", $yfksubs::prevsort); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + $ret = uc($ret); + &changeconfig($original, "prevsort=$ret"); + } + } + elsif ($choice == 28) { + $original = "browser=$yfksubs::browser"; + my $ret = &askbox(10,10,4,60, 'filename', + "Web browser for QRZ lookups?", $yfksubs::browser); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "browser=$ret"); + } + } + elsif ($choice == 29) { + $original = "colors=$colors"; + my $ret = &askbox(10,10,4,60, '[10]', + "Use colors? [1/0]", $colors); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "colors=$ret"); + } + } + elsif ($choice == 30) { + $original = "usehamdb=$yfksubs::usehamdb"; + my $ret = &askbox(10,20,4,30, '[01]', "Use Ham::Callsign::DB? 1=yes, 0=no", + $yfksubs::usehamdb); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "usehamdb=$ret"); + } + } + elsif ($choice == 31) { + $original = "qsldetails=$qsldetails"; + my $ret = &askbox(10,20,4,30, '[01]', "Show QSO details? 1=yes, 0=no", + $qsldetails); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "qsldetails=$ret"); + } + } + elsif ($choice == 32) { + $original = "drem=$drem"; + my $ret = &askbox(10,20,4,30, 'text', "Default remarks text?", + $drem); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "drem=$ret"); + } + } + elsif ($choice == 33) { + $original = "serial=$serial"; + my $ret = &askbox(10,20,4,30, 'text', "Default serial nr. (0 = none)?", + $serial); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "serial=$ret"); + } + } + elsif ($choice == 34) { # todo: askbox doesn't scroll beyond initial size + $original = "lotwlocation=$yfksubs::lotwlocation"; + my $ret = &askbox(10,5,4,70, '[A-Za-z0-9\-\/_,:]', "LoTW station locations?", $yfksubs::lotwlocation); + if ($ret eq 'm') { last } + elsif ($ret ne '') { + &changeconfig($original, "lotwlocation=$ret"); + } + } + &readconfig; + &readsubconfig; } } # end of MAIN PROGRAM LOOP diff --git a/yfksubs.pl b/yfksubs.pl index 6e2ad07..0b2e26f 100644 --- a/yfksubs.pl +++ b/yfksubs.pl @@ -37,7 +37,7 @@ connectdb connectrig jumpfield receive_qso tqslsign getlotwlocations getlotwstartdate downloadlotw redraw create_windows); use strict; -use POSIX; # needed for acos in distance/direction calculation +use POSIX; # needed for acos in distance/direction calculation use Curses; use Net::FTP; use IO::Socket; @@ -48,56 +48,56 @@ use LWP::UserAgent (); my $havehamdb = eval "require Ham::Callsign::DB;"; my $hamdb; if ($havehamdb) { - require Ham::Callsign::DB; - $hamdb = new Ham::Callsign::DB(); - $hamdb->initialize_dbs(); + require Ham::Callsign::DB; + $hamdb = new Ham::Callsign::DB(); + $hamdb->initialize_dbs(); } # We load the default values for some variables that can be changed in .yfklog my $lidadditions="^QRP\$|^LGT\$"; my $csadditions="(^P\$)|(^M{1,2}\$)|(^AM\$)"; -our $dbserver = ''; # Standard MySQL server -our $dbport = 3306; # standard MySQL port -our $dbuser = ""; # DB username -our $dbpass = ""; # DB password -our $dbname = ""; # DB name +our $dbserver = ''; # Standard MySQL server +our $dbport = 3306; # standard MySQL port +our $dbuser = ""; # DB username +our $dbpass = ""; # DB password +our $dbname = ""; # DB name my $dbh; our $onlinedata = "`CALL`, `DATE`, round(`BAND`,2), `MODE`"; - # Fields for online search log -our $ftpserver = "127.0.0.1"; # ftp for online log / backup -my $ftpport = "21"; # ftp server port -my $ftpuser = ""; # ftp user -my $ftppass = ""; # ftp passwd -my $ftpdir = "log/"; # ftp directory -our $mycall = "L1D"; # too stupid to set it? :-)) -our $dpwr = "100"; # default PWR -our $dqslsi = "N"; # def. QSL-s for import -our $dqsls = "N"; # def. QSL-s -our $operator = ""; # default OP. -our $lat1 = "52"; # Latitude of own station -our $lon1 = "-8"; # Longitude of own station -our $bands = '160 80 40 30 20 17 15 12 10 2'; # bands for award purposes -our $modes = 'CW SSB'; # modes for award purposes -our $screenlayout=0; # screen layout, 0 or 1 -our $rigmodel = 0; # for hamlib -our $rigpath = '/dev/ttyS0'; # for hamlib + # Fields for online search log +our $ftpserver = "127.0.0.1"; # ftp for online log / backup +my $ftpport = "21"; # ftp server port +my $ftpuser = ""; # ftp user +my $ftppass = ""; # ftp passwd +my $ftpdir = "log/"; # ftp directory +our $mycall = "L1D"; # too stupid to set it? :-)) +our $dpwr = "100"; # default PWR +our $dqslsi = "N"; # def. QSL-s for import +our $dqsls = "N"; # def. QSL-s +our $operator = ""; # default OP. +our $lat1 = "52"; # Latitude of own station +our $lon1 = "-8"; # Longitude of own station +our $bands = '160 80 40 30 20 17 15 12 10 2'; # bands for award purposes +our $modes = 'CW SSB'; # modes for award purposes +our $screenlayout=0; # screen layout, 0 or 1 +our $rigmodel = 0; # for hamlib +our $rigpath = '/dev/ttyS0'; # for hamlib my $rig=0; my $dband = '80'; my $dmode = 'CW'; -our $checklogs = ''; # add. logs to chk fr prev QSOs -our $lotwdetails='0'; # LOTW import details? -our $autoqueryrig='0'; # Query rig at new QSO? -our $directory='/tmp/'; # where to look for stuff -our $prefix="/usr"; # may be changed by 'make' -my $db=''; # sqlite or mysql? -our $fieldorder= # TAB/Field order. +our $checklogs = ''; # add. logs to chk fr prev QSOs +our $lotwdetails='0'; # LOTW import details? +our $autoqueryrig='0'; # Query rig at new QSO? +our $directory='/tmp/'; # where to look for stuff +our $prefix="/usr"; # may be changed by 'make' +my $db=''; # sqlite or mysql? +our $fieldorder= # TAB/Field order. 'CALL DATE TON TOFF BAND MODE QTH NAME QSLS QSLR RSTS RSTR REM PWR'; my @fieldorder = split(/\s+/, $fieldorder); our $usehamdb = 0; -our $askme=0; # ask before clearing QSOs etc -our $logsort="N"; # Order of log display -our $prevsort="D"; # Order of prev. QSOs +our $askme=0; # ask before clearing QSOs etc +our $logsort="N"; # Order of log display +our $prevsort="D"; # Order of prev. QSOs our $browser='dillo'; our $hamlibtcpport = 4532; our $lotwlocation=""; # LoTW station locations in format: CALL:location,CALL:location @@ -159,124 +159,124 @@ 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 = )) { # Read line into $line - if ($line =~ /^lidadditions=(.+)/) { # We read the $lidadditions - $lidadditions = $1; - } - elsif ($line =~ /^csadditions=(.+)/) { # We read the $csadditions - $csadditions = $1; - } - elsif ($line =~ /^dbserver=(.+)/) { # We read the MySQL Server - $dbserver= $1; - } - elsif ($line =~ /^dbport=(.+)/) { # We read the Server's port - $dbport = $1; - } - elsif ($line =~ /^mycall=(.+)/) { # We read the own call - $mycall = "\L$1"; - } - elsif ($line =~ /^dbuser=(.+)/) { # We read the db Username - $dbuser = $1; - } - elsif ($line =~ /^dbpass=(.+)/) { # We read the db passwd - $dbpass = $1; - } - elsif ($line =~ /^dbname=(.+)/) { # We read the db name - $dbname= $1; - } - elsif ($line =~ /^onlinedata=(.+)/) { # We read the columns for - $onlinedata= $1; # the online logbook - } - elsif ($line =~ /^ftpserver=(.+)/) { # We read the ftp server - $ftpserver= $1; - } - elsif ($line =~ /^ftpport=(.+)/) { # We read the ftp port - $ftpport= $1; - } - elsif ($line =~ /^ftpuser=(.+)/) { # We read the ftp username - $ftpuser= $1; - } - elsif ($line =~ /^ftppass=(.+)/) { # We read the ftp password - $ftppass= $1; - } - elsif ($line =~ /^ftpdir=(.+)/) { # We read the ftp directory - $ftpdir= $1; - } - elsif ($line =~ /^dpwr=(.+)/) { # We read the default PWR - $dpwr = $1; - } - elsif ($line =~ /^dqslsi=(.+)/) { # def. QSL-sent fr QSO imp. - $dqslsi= $1; - } - elsif ($line =~ /^dqsls=(.+)/) { # def. QSL-sent - $dqsls= $1; - } - elsif ($line =~ /^lat=(.+)/) { # Own latitude - $lat1= $1; - } - elsif ($line =~ /^lon=(.+)/) { # Own longitude - $lon1= $1; - } - elsif ($line =~ /^awardbands=(.+)/) { # bands for award purposes - $bands= $1; - } - elsif ($line =~ /^awardmodes=(.+)/) { # modes for award purposes - $modes= $1; - } - elsif ($line =~ /^screenlayout=(.+)/) { # screen layout, see doc. - $screenlayout= $1; - } - elsif ($line =~ /^rigmodel=(.+)/) { - $rigmodel= $1; - } - elsif ($line =~ /^rigpath=(.+)/) { - $rigpath = $1; - } - elsif ($line =~ /^checklogs=(.+)/) { - $checklogs = $1; - } - elsif ($line =~ /^lotwdetails=(.+)/) { - $lotwdetails = $1; - } - elsif ($line =~ /^operator=(.+)/) { - $operator = $1; - } - elsif ($line =~ /^autoqueryrig=(.+)/) { - $autoqueryrig= $1; - } - elsif ($line =~ /^directory=(.+)/) { - $directory = $1; - } - elsif ($line =~ /^fieldorder=(.+)/) { - $fieldorder= $1; - @fieldorder = split(/\s+/, $fieldorder); - } - elsif ($line =~ /^askme=(.+)/) { - $askme = $1; - } - elsif ($line =~ /^logsort=(.+)/) { - $logsort= $1; - } - elsif ($line =~ /^prevsort=(.+)/) { - $prevsort = $1; - } - elsif ($line =~ /^browser=(.+)/) { - $browser= $1; - } - elsif ($line =~ /^usehamdb=(.+)/) { - $usehamdb= $1; - } - elsif ($line =~ /^lotwlocation=(.+)/) { +while (defined (my $line = )) { # Read line into $line + if ($line =~ /^lidadditions=(.+)/) { # We read the $lidadditions + $lidadditions = $1; + } + elsif ($line =~ /^csadditions=(.+)/) { # We read the $csadditions + $csadditions = $1; + } + elsif ($line =~ /^dbserver=(.+)/) { # We read the MySQL Server + $dbserver= $1; + } + elsif ($line =~ /^dbport=(.+)/) { # We read the Server's port + $dbport = $1; + } + elsif ($line =~ /^mycall=(.+)/) { # We read the own call + $mycall = "\L$1"; + } + elsif ($line =~ /^dbuser=(.+)/) { # We read the db Username + $dbuser = $1; + } + elsif ($line =~ /^dbpass=(.+)/) { # We read the db passwd + $dbpass = $1; + } + elsif ($line =~ /^dbname=(.+)/) { # We read the db name + $dbname= $1; + } + elsif ($line =~ /^onlinedata=(.+)/) { # We read the columns for + $onlinedata= $1; # the online logbook + } + elsif ($line =~ /^ftpserver=(.+)/) { # We read the ftp server + $ftpserver= $1; + } + elsif ($line =~ /^ftpport=(.+)/) { # We read the ftp port + $ftpport= $1; + } + elsif ($line =~ /^ftpuser=(.+)/) { # We read the ftp username + $ftpuser= $1; + } + elsif ($line =~ /^ftppass=(.+)/) { # We read the ftp password + $ftppass= $1; + } + elsif ($line =~ /^ftpdir=(.+)/) { # We read the ftp directory + $ftpdir= $1; + } + elsif ($line =~ /^dpwr=(.+)/) { # We read the default PWR + $dpwr = $1; + } + elsif ($line =~ /^dqslsi=(.+)/) { # def. QSL-sent fr QSO imp. + $dqslsi= $1; + } + elsif ($line =~ /^dqsls=(.+)/) { # def. QSL-sent + $dqsls= $1; + } + elsif ($line =~ /^lat=(.+)/) { # Own latitude + $lat1= $1; + } + elsif ($line =~ /^lon=(.+)/) { # Own longitude + $lon1= $1; + } + elsif ($line =~ /^awardbands=(.+)/) { # bands for award purposes + $bands= $1; + } + elsif ($line =~ /^awardmodes=(.+)/) { # modes for award purposes + $modes= $1; + } + elsif ($line =~ /^screenlayout=(.+)/) { # screen layout, see doc. + $screenlayout= $1; + } + elsif ($line =~ /^rigmodel=(.+)/) { + $rigmodel= $1; + } + elsif ($line =~ /^rigpath=(.+)/) { + $rigpath = $1; + } + elsif ($line =~ /^checklogs=(.+)/) { + $checklogs = $1; + } + elsif ($line =~ /^lotwdetails=(.+)/) { + $lotwdetails = $1; + } + elsif ($line =~ /^operator=(.+)/) { + $operator = $1; + } + elsif ($line =~ /^autoqueryrig=(.+)/) { + $autoqueryrig= $1; + } + elsif ($line =~ /^directory=(.+)/) { + $directory = $1; + } + elsif ($line =~ /^fieldorder=(.+)/) { + $fieldorder= $1; + @fieldorder = split(/\s+/, $fieldorder); + } + elsif ($line =~ /^askme=(.+)/) { + $askme = $1; + } + elsif ($line =~ /^logsort=(.+)/) { + $logsort= $1; + } + elsif ($line =~ /^prevsort=(.+)/) { + $prevsort = $1; + } + elsif ($line =~ /^browser=(.+)/) { + $browser= $1; + } + elsif ($line =~ /^usehamdb=(.+)/) { + $usehamdb= $1; + } + elsif ($line =~ /^lotwlocation=(.+)/) { $lotwlocation = $1; - } - elsif ($line =~ /^lotwuser=(.+)/) { + } + elsif ($line =~ /^lotwuser=(.+)/) { $lotwuser= $1; - } - elsif ($line =~ /^lotwpass=(.+)/) { + } + elsif ($line =~ /^lotwpass=(.+)/) { $lotwpass = $1; - } + } } -close CONFIG; # Configuration read. +close CONFIG; # Configuration read. return 1; @@ -284,8 +284,8 @@ return 1; # Only open Database when config file was read. if (&readsubconfig()) { - &connectdb; - &connectrig; + &connectdb; + &connectrig; } ## We connect to the Database now... @@ -293,15 +293,15 @@ if (&readsubconfig()) { sub connectdb { if ($dbserver eq 'sqlite') { - $db = 'sqlite'; - $dbh = DBI->connect("DBI:SQLite:dbname=$ENV{HOME}/.yfklog/$dbname", - $dbuser, $dbpass) - or die "Could not connect to SQLite database: " . DBI->errstr; + $db = 'sqlite'; + $dbh = DBI->connect("DBI:SQLite:dbname=$ENV{HOME}/.yfklog/$dbname", + $dbuser, $dbpass) + or die "Could not connect to SQLite database: " . DBI->errstr; } -else { # MYSQL, only if defined. - $db = 'mysql'; - $dbh = DBI->connect("DBI:mysql:$dbname;host=$dbserver",$dbuser,$dbpass) - or die "Could not connect to MySQL database: " . DBI->errstr; +else { # MYSQL, only if defined. + $db = 'mysql'; + $dbh = DBI->connect("DBI:mysql:$dbname;host=$dbserver",$dbuser,$dbpass) + or die "Could not connect to MySQL database: " . DBI->errstr; } } @@ -309,38 +309,38 @@ else { # MYSQL, only if defined. # Open Rig for Hamlib sub connectrig { - if ( $autoqueryrig eq 1) { - if (-r '/usr/local/share/yfklog/rigctld.sh') { - system('sh /usr/local/share/yfklog/rigctld.sh'); - sleep 1; - } - } + if ( $autoqueryrig eq 1) { + if (-r '/usr/local/share/yfklog/rigctld.sh') { + system('sh /usr/local/share/yfklog/rigctld.sh'); + sleep 1; + } + } } # Now we read cty.dat or exit when it's not found. my $ctydat = "$prefix/share/yfklog/cty.dat"; if (-R "./cty.dat") { - $ctydat = "./cty.dat"; + $ctydat = "./cty.dat"; } open CTY, "$ctydat" or die "$ctydat not found.". - "Please download it from http://country-files.com/\n"; + "Please download it from http://country-files.com/\n"; my %fullcalls; # hash of full calls (=DL1XYZ) -my %prefixes; # hash of arrays main prefix -> (all, prefixes,..) -my %dxcc; # hash of arrays main prefix -> (CQZ, ITUZ, ...) +my %prefixes; # hash of arrays main prefix -> (all, prefixes,..) +my %dxcc; # hash of arrays main prefix -> (CQZ, ITUZ, ...) my $mainprefix; while (my $line = ) { - if (substr($line, 0, 1) ne ' ') { # New DXCC - $line =~ /\s+([*A-Za-z0-9\/]+):\s+$/; - $mainprefix = $1; - $line =~ s/\s{2,}//g; - @{$dxcc{$mainprefix}} = split(/:/, $line); - } - else { # prefix-line - $line =~ s/\s+//g; + if (substr($line, 0, 1) ne ' ') { # New DXCC + $line =~ /\s+([*A-Za-z0-9\/]+):\s+$/; + $mainprefix = $1; + $line =~ s/\s{2,}//g; + @{$dxcc{$mainprefix}} = split(/:/, $line); + } + else { # prefix-line + $line =~ s/\s+//g; # read full calls into separate hash. this hash only # contains the information that this is a full call and @@ -360,13 +360,13 @@ while (my $line = ) { $line =~ s/=//g; # handle "normal" prefixes - unless (defined($prefixes{$mainprefix}[0])) { - @{$prefixes{$mainprefix}} = split(/,|;/, $line); - } - else { - push(@{$prefixes{$mainprefix}}, split(/,|;/, $line)); - } - } + unless (defined($prefixes{$mainprefix}[0])) { + @{$prefixes{$mainprefix}} = split(/,|;/, $line); + } + else { + push(@{$prefixes{$mainprefix}}, split(/,|;/, $line)); + } + } } close CTY; @@ -394,7 +394,7 @@ sub wpx { # as used by RDA-DXpeditions.... if ($call =~ - /^((\d|[A-Z])+\/)?((\d|[A-Z]){3,})(\/(\d|[A-Z])+)?(\/(\d|[A-Z])+)?$/) { + /^((\d|[A-Z])+\/)?((\d|[A-Z]){3,})(\/(\d|[A-Z])+)?(\/(\d|[A-Z])+)?$/) { # Now $1 holds A (incl /), $3 holds the callsign B and $5 has C # We save them to $a, $b and $c respectively to ensure they won't get @@ -422,13 +422,13 @@ if (!$c && $a && $b) { # $a and $b exist, no $c } } - # *** Added later *** The check didn't make sure that the callsign - # contains a letter. there are letter-only callsigns like RAEM, but not - # figure-only calls. + # *** Added later *** The check didn't make sure that the callsign + # contains a letter. there are letter-only callsigns like RAEM, but not + # figure-only calls. - if ($b =~ /^[0-9]+$/) { # Callsign only consists of numbers. Bad! - return undef; # exit, undef - } + if ($b =~ /^[0-9]+$/) { # Callsign only consists of numbers. Bad! + return undef; # exit, undef + } # Depending on these values we have to determine the prefix. # Following cases are possible: @@ -472,11 +472,11 @@ if (!$c && $a && $b) { # $a and $b exist, no $c $b =~ /(.+\d)[A-Z]*/; # Known attachment -> like Case 1.1 $prefix = $1; } - elsif ($c =~ /^\d\d+$/) { # more than 2 numbers -> ignore + elsif ($c =~ /^\d\d+$/) { # more than 2 numbers -> ignore $b =~ /(.+\d)[A-Z]*/; # see above $prefix = $1; - } - else { # Must be a Prefix! + } + else { # Must be a Prefix! if ($c =~ /\d$/) { # ends in number -> good prefix $prefix = $c; } @@ -541,13 +541,13 @@ else { return undef; } # no proper callsign received. ############################################################################### sub dxcc { - my $testcall = shift; - my $matchchars=0; - my $matchprefix=''; - my $test; - my $zones = ''; # annoying zone exceptions - my $goodzone; - my $letter=''; + my $testcall = shift; + my $matchchars=0; + my $matchprefix=''; + my $test; + my $zones = ''; # annoying zone exceptions + my $goodzone; + my $letter=''; if ($fullcalls{$testcall}) { # direct match with "=" @@ -567,11 +567,11 @@ elsif ($testcall =~ /(^LZ\/)|(\/LZ[1-9]?$)/) { # LZ/ is LZ0 by DXCC but this is $testcall = "LZ"; } elsif ($testcall =~ /\//) { # check if the callsign has a "/" - my $prfx = &wpx($testcall,1); - unless (defined($prfx)) { - $prfx = "QQ"; # invalid - } - $testcall = $prfx."AA"; # use the wpx prefix instead, which may + my $prfx = &wpx($testcall,1); + unless (defined($prfx)) { + $prfx = "QQ"; # invalid + } + $testcall = $prfx."AA"; # use the wpx prefix instead, which may # intentionally be wrong, see &wpx! } @@ -579,49 +579,49 @@ $letter = substr($testcall, 0,1); foreach $mainprefix (keys %prefixes) { - foreach $test (@{$prefixes{$mainprefix}}) { - my $len = length($test); - - if ($letter ne substr($test,0,1)) { # gains 20% speed - next; - } - - $zones = ''; - - if (($len > 5) && ((index($test, '(') > -1) # extra zones - || (index($test, '[') > -1))) { - $test =~ /^([A-Z0-9\/]+)([\[\(].+)/; - $zones .= $2 if defined $2; - $len = length($1); - } - - if ((substr($testcall, 0, $len) eq substr($test,0,$len)) && - ($matchchars <= $len)) { - $matchchars = $len; - $matchprefix = $mainprefix; - $goodzone = $zones; - } - } + foreach $test (@{$prefixes{$mainprefix}}) { + my $len = length($test); + + if ($letter ne substr($test,0,1)) { # gains 20% speed + next; + } + + $zones = ''; + + if (($len > 5) && ((index($test, '(') > -1) # extra zones + || (index($test, '[') > -1))) { + $test =~ /^([A-Z0-9\/]+)([\[\(].+)/; + $zones .= $2 if defined $2; + $len = length($1); + } + + if ((substr($testcall, 0, $len) eq substr($test,0,$len)) && + ($matchchars <= $len)) { + $matchchars = $len; + $matchprefix = $mainprefix; + $goodzone = $zones; + } + } } -my @mydxcc; # save typing work +my @mydxcc; # save typing work if (defined($dxcc{$matchprefix})) { - @mydxcc = @{$dxcc{$matchprefix}}; + @mydxcc = @{$dxcc{$matchprefix}}; } else { - @mydxcc = qw/Unknown 0 0 0 0 0 0 ?/; + @mydxcc = qw/Unknown 0 0 0 0 0 0 ?/; } # Different zones? if ($goodzone) { - if ($goodzone =~ /\((\d+)\)/) { # CQ-Zone in () - $mydxcc[1] = $1; - } - if ($goodzone =~ /\[(\d+)\]/) { # ITU-Zone in [] - $mydxcc[2] = $1; - } + if ($goodzone =~ /\((\d+)\)/) { # CQ-Zone in () + $mydxcc[1] = $1; + } + if ($goodzone =~ /\[(\d+)\]/) { # ITU-Zone in [] + $mydxcc[2] = $1; + } } # cty.dat has special entries for WAE countries which are not separate DXCC @@ -629,13 +629,13 @@ if ($goodzone) { # to the proper DXCC. Since there are opnly a few of them, it is hardcoded in # here. -if ($mydxcc[7] =~ /^\*/) { # WAE country! - if ($mydxcc[7] eq '*TA1') { $mydxcc[7] = "TA" } # Turkey - if ($mydxcc[7] eq '*4U1V') { $mydxcc[7] = "OE" } # 4U1VIC is in OE.. - if ($mydxcc[7] eq '*GM/s') { $mydxcc[7] = "GM" } # Shetlands - if ($mydxcc[7] eq '*IG9') { $mydxcc[7] = "I" } # African Italy - if ($mydxcc[7] eq '*IT9') { $mydxcc[7] = "I" } # Sicily - if ($mydxcc[7] eq '*JW/b') { $mydxcc[7] = "JW" } # Bear Island +if ($mydxcc[7] =~ /^\*/) { # WAE country! + if ($mydxcc[7] eq '*TA1') { $mydxcc[7] = "TA" } # Turkey + if ($mydxcc[7] eq '*4U1V') { $mydxcc[7] = "OE" } # 4U1VIC is in OE.. + if ($mydxcc[7] eq '*GM/s') { $mydxcc[7] = "GM" } # Shetlands + if ($mydxcc[7] eq '*IG9') { $mydxcc[7] = "I" } # African Italy + if ($mydxcc[7] eq '*IT9') { $mydxcc[7] = "I" } # Sicily + if ($mydxcc[7] eq '*JW/b') { $mydxcc[7] = "JW" } # Bear Island } @@ -660,11 +660,11 @@ return @mydxcc; ############################################################################### sub makewindow { - my $wind = newwin($_[0], $_[1], $_[2], $_[3]); # create window - attron($wind, COLOR_PAIR($_[4])); # set colors - addstr($wind, 0,0, " " x ($_[0]*$_[1])); # print x*y whitespaces - move($wind, 0,0); # cursor back to start - return $wind; # return window + my $wind = newwin($_[0], $_[1], $_[2], $_[3]); # create window + attron($wind, COLOR_PAIR($_[4])); # set colors + addstr($wind, 0,0, " " x ($_[0]*$_[1])); # print x*y whitespaces + move($wind, 0,0); # cursor back to start + return $wind; # return window } ########################################################################### @@ -675,18 +675,18 @@ sub makewindow { ########################################################################## sub clearinputfields { - my @wi = @{$_[0]}; # Input windows - my $num; # number of QSOs to delete.. - - if ($_[1] == 1) { $num = 14 } - else { $num = 26 } - - for (my $a=0;$a < $num;$a++) { # go through all fields - attron($wi[$a], COLOR_PAIR(5)); # input fields fg white, bg black - addstr($wi[$a], 0,0, " " x 80); # lots of spaces to fill the window - move($wi[$a], 0,0); # move cursor home - refresh($wi[$a]); # refresh - } + my @wi = @{$_[0]}; # Input windows + my $num; # number of QSOs to delete.. + + if ($_[1] == 1) { $num = 14 } + else { $num = 26 } + + for (my $a=0;$a < $num;$a++) { # go through all fields + attron($wi[$a], COLOR_PAIR(5)); # input fields fg white, bg black + addstr($wi[$a], 0,0, " " x 80); # lots of spaces to fill the window + move($wi[$a], 0,0); # move cursor home + refresh($wi[$a]); # refresh + } } @@ -700,17 +700,17 @@ sub clearinputfields { sub qsotofields { my @qso= @{$_[0]}; # reference to QSO my @wi = @{$_[1]}; # reference to input-windows - my $num; # number of windows to paint + my $num; # number of windows to paint - if ($_[2] == 1) { $num = 14 } - else { $num = 26 } + if ($_[2] == 1) { $num = 14 } + else { $num = 26 } - for (my $a=0;$a < $num;$a++) { # go through all fields in range - attron($wi[$a], COLOR_PAIR(5)); # input fields fg white, bg black - addstr($wi[$a], 0,0, $qso[$a]. " " x 80); # put QSO value + spaces - move($wi[$a], 0,0); # move cursor home - refresh($wi[$a]); # refresh - } + for (my $a=0;$a < $num;$a++) { # go through all fields in range + attron($wi[$a], COLOR_PAIR(5)); # input fields fg white, bg black + addstr($wi[$a], 0,0, $qso[$a]. " " x 80); # put QSO value + spaces + move($wi[$a], 0,0); # move cursor home + refresh($wi[$a]); # refresh + } } ############################################################################## @@ -729,190 +729,190 @@ sub qsotofields { ############################################################################## sub saveqso { - my $qslinfo = ""; # QSLinfo, IOTA and STATE will be read from the - my $iota= ""; # remarks field, if available. - my $state = ""; - my $grid= ""; - my @qso = (shift,shift,shift,shift,shift,shift,shift,shift,shift,shift, - shift,shift,shift,shift); # get the @qso array - my $editnr = shift; # QSO we edit - - if ($editnr) { # if existing QSO try get qslinfo - my $n = $dbh->prepare("SELECT `QSLINFO` FROM log_$mycall - WHERE `NR`='$editnr';"); - $n->execute(); - my @qslinfo = $n->fetchrow_array(); # local variable for info array - $qslinfo = $qslinfo[0]; - } - - # Cute date/times, just in case. - $qso[1] = substr($qso[1],0,8); - $qso[2] = substr($qso[2],0,4); - $qso[3] = substr($qso[3],0,4); - - # Now we have to check if it is a valid entry - if ((my $pfx = &wpx($qso[0]) ) && # check for a callsign, return PFX - (length($qso[1]) == 8) && # check if date has proper length - (substr($qso[1],0,2) < 32) && # sane day (of course not in all months) - (substr($qso[1],2,2) < 13) && # valid month - (substr($qso[1],4,) > 1900) && # :-) - (length($qso[2]) == 4) && # check length of time on - (substr($qso[2],0,2) < 24) && # valid hour in Time on - (substr($qso[2],3,2) < 60) && # valid minute Time on - ($qso[4] ne "") && # band has some info - ($qso[5] ne "") && # mode has some info - ($qso[8] ne "") && # QSL sent - ($qso[9] ne "") # QSL rxed - # RST, PWR not checked, will be 599 / 0 by default in the database, - # Time-OFF can be "", if so, it will be replaced with current time - ) { # VALID ENTRY! put into database - - # unless we have a valid time off ... - unless ((length($qso[3]) == 4) && # check length of time off - (substr($qso[3],0,2) < 24) && # valid hour in Time on - (substr($qso[3],2,2) < 60)){ # valid minute Time on - $qso[3] = &gettime; # time off = current time - } # Time off ready - - $qso[1] = # make date in YYYY-MM-DD format - substr($qso[1],4,)."-".substr($qso[1],2,2)."-".substr($qso[1],0,2); - - $qso[2] = substr($qso[2],0,2).":".substr($qso[2],2,2).":00";# add seconds, : - $qso[3] = substr($qso[3],0,2).":".substr($qso[3],2,2).":00";# add seconds, : - - my @dxcc = &dxcc($qso[0]); # get DXCC-array - my $dxcc = $dxcc[7]; # dxcc prefix - my $cont = $dxcc[3]; # dxcc continent - my $ituz = $dxcc[2]; # dxcc itu zone - my $cqz = $dxcc[1]; # dxcc CQ zone - - # searching for QSL-INFO in remarks-field: - if ($qso[12] =~ /(.*)via:(\w+)(.*)/){ # QSL info in remarks field - $qslinfo = $2; # save QSL-info - $qso[12] = $1." ".$3; # cut qsl-info from remarks field - $qslinfo =~ tr/[a-z]/[A-Z]/; # make qsl-info uppercase - } - - # searching for different ITUZ in remarks-field: - # Note: ITU-Zone should be entered as "3" and not "03" e.g.!! - if ($qso[12] =~ /(.*)ITUZ:(\w+)(.*)/){ - my ($a, $b, $c) = ($1, $2, $3); # save regex results - # A valid ITU Zone is 01..90 - if (($b =~ /^\d\d$/) && ($b > 0) && ($b < 91)) { - $ituz = $b; - $qso[12] = $a." ".$c; - } - } - - # searching for different CQZ in remarks-field: - if ($qso[12] =~ /(.*)CQZ:(\w+)(.*)/){ - my ($a, $b, $c) = ($1, $2, $3); # save regex results - # A valid CQ Zone is 01..40 - if (($b =~ /^\d\d$/) && ($b > 0) && ($b < 41)) { - $cqz = $b; - $qso[12] = $a." ".$c; - } - } - - # searching for a STATE in remarks-field: - if ($qso[12] =~ /(.*)STATE:(\w\w)(.*)/){ - $state = $2; - $qso[12] = $1." ".$3; - } - - # searching for a IOTA Nr in remarks-field: - if ($qso[12] =~ /(.*)IOTA:(\w\w-\d\d\d)(.*)/){ - my ($a, $b, $c) = ($1, $2, $3); # save regex results - # A valid IOTA NR starts with a continent. Check this: - if (substr($b,0,2) =~ /(EU|AF|AS|OC|NA|SA|AN)/) { - $iota =$b; - $qso[12] = $a." ".$c; - } - } - - # searching for an OPERATOR in remarks-field: - if ($qso[12] =~ /(.*)OPERATOR:(\w+)(.*)/){ - $operator = $2; - $qso[12] = $1." ".$3; - } - - # searching for a GRID in remarks-field. 4 or 6 letters - if ($qso[12] =~ - /(.*)GRID:([A-Z]{2}[0-9]{2}[A-Z]{2}|[A-Z]{2}[0-9]{2})(.*)/){ - $grid = $2; - $qso[12] = $1." ".$3; - } - - # trim remark - $qso[12] =~ s/\s*$//; - - # we are now ready to save the QSO, but we have to check if it's a - # new QSO or if we are changing an existing QSO. - - if ($editnr) { # we change an existing QSO - $dbh->do("UPDATE log_$mycall SET `CALL`='$qso[0]', - `DATE`='$qso[1]', - `T_ON`='$qso[2]', `T_OFF`='$qso[3]', `BAND`='$qso[4]', - `MODE`='$qso[5]', `QTH`='$qso[6]', `NAME`='$qso[7]', - `QSLS`='$qso[8]', `QSLR`='$qso[9]', `RSTS`='$qso[10]', - `RSTR`='$qso[11]', `REM`='$qso[12]', `PWR`='$qso[13]', - `QSLINFO`='$qslinfo' WHERE NR='$editnr';"); - } - else { # new QSO - $dbh->do("INSERT INTO log_$mycall - (`CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, `MODE`, `QTH`, - `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR`, - `DXCC`, `PFX`, `CONT`, `QSLINFO`, - `ITUZ`, `CQZ`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID`) - VALUES ('$qso[0]', '$qso[1]', '$qso[2]', '$qso[3]', - '$qso[4]', '$qso[5]', '$qso[6]', '$qso[7]', - '$qso[8]', '$qso[9]', '$qso[10]', '$qso[11]', - '$qso[12]', '$qso[13]', '$dxcc', '$pfx', - '$cont', '$qslinfo', '$ituz', '$cqz', '$iota', - '$state', 'N', '$operator', '$grid');"); - } - - - # voila, we have saved the QSO. Now we check if the callsign's name - # and QTH info is already contained in the "calls"-table; if not, - # we save it there. first we cut the callsign down to the homecall - # only, by splitting it up at every /, then taking the longest - # part. - # - my $call=$qso[0]; # will be the homecall - my @call = split(/\//, $call); # split at every / - my $length=0; # length of splitted part - foreach(@call) { # chose longest part - if (length($_) >= $length) { - $length = length($_); - $call = $_; - } - } - - my $sth = $dbh->prepare("SELECT `CALL` FROM calls WHERE - `CALL`='$call';"); - $sth->execute(); - unless ($sth->fetch()) { # check if callsign not in DB - if (($qso[7] ne "") || ($qso[6] ne "")) { # new things to add - $dbh->do("INSERT INTO `calls` (`CALL`, `NAME`, `QTH`) VALUES - ('$call', '$qso[7]', '$qso[6]');"); - } - } - - # until now this only inserts, when both Name and QTH are unknown; - # it doesn't update when only one part is unknown. needed? - return 1; # successfully saved - } - else { # QSO invalid. Check what is wrong, make error msg - &finderror(@qso); - return 0; - } + my $qslinfo = ""; # QSLinfo, IOTA and STATE will be read from the + my $iota= ""; # remarks field, if available. + my $state = ""; + my $grid= ""; + my @qso = (shift,shift,shift,shift,shift,shift,shift,shift,shift,shift, + shift,shift,shift,shift); # get the @qso array + my $editnr = shift; # QSO we edit + + if ($editnr) { # if existing QSO try get qslinfo + my $n = $dbh->prepare("SELECT `QSLINFO` FROM log_$mycall + WHERE `NR`='$editnr';"); + $n->execute(); + my @qslinfo = $n->fetchrow_array(); # local variable for info array + $qslinfo = $qslinfo[0]; + } + + # Cute date/times, just in case. + $qso[1] = substr($qso[1],0,8); + $qso[2] = substr($qso[2],0,4); + $qso[3] = substr($qso[3],0,4); + + # Now we have to check if it is a valid entry + if ((my $pfx = &wpx($qso[0]) ) && # check for a callsign, return PFX + (length($qso[1]) == 8) && # check if date has proper length + (substr($qso[1],0,2) < 32) && # sane day (of course not in all months) + (substr($qso[1],2,2) < 13) && # valid month + (substr($qso[1],4,) > 1900) && # :-) + (length($qso[2]) == 4) && # check length of time on + (substr($qso[2],0,2) < 24) && # valid hour in Time on + (substr($qso[2],3,2) < 60) && # valid minute Time on + ($qso[4] ne "") && # band has some info + ($qso[5] ne "") && # mode has some info + ($qso[8] ne "") && # QSL sent + ($qso[9] ne "") # QSL rxed + # RST, PWR not checked, will be 599 / 0 by default in the database, + # Time-OFF can be "", if so, it will be replaced with current time + ) { # VALID ENTRY! put into database + + # unless we have a valid time off ... + unless ((length($qso[3]) == 4) && # check length of time off + (substr($qso[3],0,2) < 24) && # valid hour in Time on + (substr($qso[3],2,2) < 60)){ # valid minute Time on + $qso[3] = &gettime; # time off = current time + } # Time off ready + + $qso[1] = # make date in YYYY-MM-DD format + substr($qso[1],4,)."-".substr($qso[1],2,2)."-".substr($qso[1],0,2); + + $qso[2] = substr($qso[2],0,2).":".substr($qso[2],2,2).":00";# add seconds, : + $qso[3] = substr($qso[3],0,2).":".substr($qso[3],2,2).":00";# add seconds, : + + my @dxcc = &dxcc($qso[0]); # get DXCC-array + my $dxcc = $dxcc[7]; # dxcc prefix + my $cont = $dxcc[3]; # dxcc continent + my $ituz = $dxcc[2]; # dxcc itu zone + my $cqz = $dxcc[1]; # dxcc CQ zone + + # searching for QSL-INFO in remarks-field: + if ($qso[12] =~ /(.*)via:(\w+)(.*)/){ # QSL info in remarks field + $qslinfo = $2; # save QSL-info + $qso[12] = $1." ".$3; # cut qsl-info from remarks field + $qslinfo =~ tr/[a-z]/[A-Z]/; # make qsl-info uppercase + } + + # searching for different ITUZ in remarks-field: + # Note: ITU-Zone should be entered as "3" and not "03" e.g.!! + if ($qso[12] =~ /(.*)ITUZ:(\w+)(.*)/){ + my ($a, $b, $c) = ($1, $2, $3); # save regex results + # A valid ITU Zone is 01..90 + if (($b =~ /^\d\d$/) && ($b > 0) && ($b < 91)) { + $ituz = $b; + $qso[12] = $a." ".$c; + } + } + + # searching for different CQZ in remarks-field: + if ($qso[12] =~ /(.*)CQZ:(\w+)(.*)/){ + my ($a, $b, $c) = ($1, $2, $3); # save regex results + # A valid CQ Zone is 01..40 + if (($b =~ /^\d\d$/) && ($b > 0) && ($b < 41)) { + $cqz = $b; + $qso[12] = $a." ".$c; + } + } + + # searching for a STATE in remarks-field: + if ($qso[12] =~ /(.*)STATE:(\w\w)(.*)/){ + $state = $2; + $qso[12] = $1." ".$3; + } + + # searching for a IOTA Nr in remarks-field: + if ($qso[12] =~ /(.*)IOTA:(\w\w-\d\d\d)(.*)/){ + my ($a, $b, $c) = ($1, $2, $3); # save regex results + # A valid IOTA NR starts with a continent. Check this: + if (substr($b,0,2) =~ /(EU|AF|AS|OC|NA|SA|AN)/) { + $iota =$b; + $qso[12] = $a." ".$c; + } + } + + # searching for an OPERATOR in remarks-field: + if ($qso[12] =~ /(.*)OPERATOR:(\w+)(.*)/){ + $operator = $2; + $qso[12] = $1." ".$3; + } + + # searching for a GRID in remarks-field. 4 or 6 letters + if ($qso[12] =~ + /(.*)GRID:([A-Z]{2}[0-9]{2}[A-Z]{2}|[A-Z]{2}[0-9]{2})(.*)/){ + $grid = $2; + $qso[12] = $1." ".$3; + } + + # trim remark + $qso[12] =~ s/\s*$//; + + # we are now ready to save the QSO, but we have to check if it's a + # new QSO or if we are changing an existing QSO. + + if ($editnr) { # we change an existing QSO + $dbh->do("UPDATE log_$mycall SET `CALL`='$qso[0]', + `DATE`='$qso[1]', + `T_ON`='$qso[2]', `T_OFF`='$qso[3]', `BAND`='$qso[4]', + `MODE`='$qso[5]', `QTH`='$qso[6]', `NAME`='$qso[7]', + `QSLS`='$qso[8]', `QSLR`='$qso[9]', `RSTS`='$qso[10]', + `RSTR`='$qso[11]', `REM`='$qso[12]', `PWR`='$qso[13]', + `QSLINFO`='$qslinfo' WHERE NR='$editnr';"); + } + else { # new QSO + $dbh->do("INSERT INTO log_$mycall + (`CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, `MODE`, `QTH`, + `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR`, + `DXCC`, `PFX`, `CONT`, `QSLINFO`, + `ITUZ`, `CQZ`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID`) + VALUES ('$qso[0]', '$qso[1]', '$qso[2]', '$qso[3]', + '$qso[4]', '$qso[5]', '$qso[6]', '$qso[7]', + '$qso[8]', '$qso[9]', '$qso[10]', '$qso[11]', + '$qso[12]', '$qso[13]', '$dxcc', '$pfx', + '$cont', '$qslinfo', '$ituz', '$cqz', '$iota', + '$state', 'N', '$operator', '$grid');"); + } + + + # voila, we have saved the QSO. Now we check if the callsign's name + # and QTH info is already contained in the "calls"-table; if not, + # we save it there. first we cut the callsign down to the homecall + # only, by splitting it up at every /, then taking the longest + # part. + # + my $call=$qso[0]; # will be the homecall + my @call = split(/\//, $call); # split at every / + my $length=0; # length of splitted part + foreach(@call) { # chose longest part + if (length($_) >= $length) { + $length = length($_); + $call = $_; + } + } + + my $sth = $dbh->prepare("SELECT `CALL` FROM calls WHERE + `CALL`='$call';"); + $sth->execute(); + unless ($sth->fetch()) { # check if callsign not in DB + if (($qso[7] ne "") || ($qso[6] ne "")) { # new things to add + $dbh->do("INSERT INTO `calls` (`CALL`, `NAME`, `QTH`) VALUES + ('$call', '$qso[7]', '$qso[6]');"); + } + } + + # until now this only inserts, when both Name and QTH are unknown; + # it doesn't update when only one part is unknown. needed? + return 1; # successfully saved + } + else { # QSO invalid. Check what is wrong, make error msg + &finderror(@qso); + return 0; + } } - + ############################################################################## # readw reads what the user types into a window, depending on $_[1], # only numbers, callsign-characters, only letters or (almost) everything @@ -953,290 +953,290 @@ sub saveqso { ############################################################################## sub readw { - my $ch; # the getchar() we read - my $win = ${$_[0]}[$_[2]]; # get window to modify - my $input = ${$_[3]}[$_[2]]; # stores what the user entered, - # init from @qso. - my $match = "[a-zA-Z0-9\/]"; # default match expression - my $pos = 0; # cursor position in the field - my $strpos = $pos; # cursor position in the string - my $wlog = ${$_[4]}; # reference to log-windw - my $editnr = ${$_[5]}; # reference to editnr - - my $debug=0; - - my $ovr = $_[6]; # overwrite - my $width = $_[7]; # width is fixed - - # The string length $strlen is used to have entries larger than the width, - # $_[2] is inspected to set the length according to SQL field length. - my $strlen = $width; - if ($_[2] == 0) { $strlen = 15; } # Call - elsif ($_[2] == 5) { $strlen = 6; } # Mode - elsif ($_[2] == 6) { $strlen = 15; } # QTH - elsif ($_[2] == 7) { $strlen = 15; } # Name - elsif ($_[2] == 10) { $strlen = 10; } # RSTs - elsif ($_[2] == 11) { $strlen = 10; } # RSTr - elsif ($_[2] == 12) { $strlen = 60; } # Remarks - elsif ($_[2] == 13) { $strlen = 10; } # PWR - - move($win,0,0); # move cursor to first position - addstr($win,0,0, $input." "x80); # pass $input to window, - refresh($win); - - # For the date, time and band only figures are allowed, - # to achieve this, invoke readw with $_[1] = 1 - if ((defined $_[1]) && ($_[1] == "1")) { # only numbers - $match = '\d'; # set match expression - } - - # For the QSL-status only letters are allowed, - # to achieve this, invoke readw with $_[1] = 2 - if ((defined $_[1]) && ($_[1] == "2")) { # only letters - $match = '[a-zA-Z]'; # set match expression - } - - # For the Name, QTH and Remarks letters, figures and punctuation is allowed - # to achieve this, invoke readw with $_[1] = 3 - if ((defined $_[1]) && ($_[1] == "3")) { - $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # set match expression - } - - # In the BAND-field, numbers and a decimal point are allowed. - if ((defined $_[1]) && ($_[1] == "4")) { - $match = '[0-9.]'; # set match expression - } - - # Now the main loop starts which is waiting for any input from the keyboard - # which is stored in $ch. If it is a valid character that matches $match, - # it will be added to the string $input at the proper place. - # - # If an arrow key LEFT or RIGHT is entered, the position within the string - # $input will be changed, considering that it can only be within - # 0..length($input-1). The position is stored in $pos. - # - # If a control character like a F-Key, Enter or Tab is found, the sub - # exists and $input is written to @qso, with attached information on which - # key was pressed, as ||F1 .. ||F10. This way we can switch to the proper - # window when we get back into the main loop. - - while (1) { # loop infinitely - - $pos-- if ($pos == $width); # keep cursor in field - $strpos-- if ($strpos == $strlen); # stop if string filled - - # If the cursor positions in the field and the string are not the same - # then give only a partial view of the string. - if ($strpos > $pos) { - if (length($input) < $width) { - $pos = $strpos; # perfect, it fits again - } - addstr($win,0,0, substr($input, $strpos-$pos, )." "x80); - } - else { - addstr($win,0,0, $input." "x80); # pass $input to window, - } # delete all after $input. - - move ($win,0,$pos); # move cursor to $pos - refresh($win); # show new window - - $ch = &getch2(); - - # We first check if it is a legal character of the specified $match, - # and if the string will not be too long. - # if so, it will be added to the string (at the proper position!) - if (($ch =~ /^$match$/) && - ((length($input) < $strlen) || ($strpos < $strlen && $ovr)) - ) { - - unless ($_[1] == 3) { # Unless Name, QTH, Remarks - $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase - } - # The new character will be added to $input at the right place. - $strpos++; - $pos++; - - if ($ovr) { - $input = substr($input, 0, $strpos-1).$ch.substr($input, - $strpos > length($input) ? $strpos-1 : $strpos, ); - } - else { - $input = substr($input, 0, $strpos-1).$ch.substr($input, - $strpos-1, ); - } - } - - # The l/r arrow keys change the position of the cursor to left or right - # but only within the boundaries of $input. - - elsif ($ch eq KEY_LEFT) { - if ($pos > 0) { $pos-- } - if ($strpos > 0) { $strpos-- } - } - - elsif ($ch eq KEY_RIGHT) { - if (($pos < length($input)) && ($pos < $width)) { $pos++ } - if ($strpos < length($input)) { $strpos++ } - } - - elsif ($ch eq KEY_HOME) { # Pos1 key - $pos = 0; - $strpos = 0; - } - - elsif ($ch eq KEY_END) { # End key - $strpos = length($input); - if ($strpos >= $strlen) {$strpos = $strlen-1;} - $pos = $strpos; - if ($pos >= $width) {$pos = $width-1;} - } - - elsif (($ch eq KEY_DC) && ($strpos < length($input))) { # Delete key - $input = substr($input, 0, $strpos).substr($input, $strpos+1, ); - } - - # BACKSPACE. When pressing backspace, the character left of the cursor - # is deleted, if it exists. For some reason, KEY_BACKSPACE only is true - # when pressing CTL+H on my system (and all the others I tested); the - # other tests lead to success, although it's probably less portable. - # Found this solution in qe.pl by Wilbert Knol, ZL2BSJ. - - elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) - && ($strpos > 0)) { - $input = substr($input, 0, $strpos-1).substr($input, $strpos, ); - $strpos--; - if ($pos > 0) { $pos--; } - } - - # Space, Tab, keydown and Enter are the keys to go to the next field, - # except in mode $_[1], where it was already caught in the first - # pattern match. If space, tab or newline is found, the sub puts - # $input into the proper place in the @qso array: ${$_[3]}[$_[2]]; - elsif (($ch =~ /^[ \t\n]$/) || $ch eq KEY_DOWN) { - ${$_[3]}[$_[2]] = $input; # save to @qso; - return 1; - } - # Arrow-up or Shift-Tab gues to the previous QSO field. Everything - # else same as above - elsif (($ch eq KEY_UP) || ($ch eq '353')) { # Cursor up or Shift-Tab - ${$_[3]}[$_[2]] = $input; # save to @qso; - return 7; # 6 -> one field back - } - - # If the pressed key was F2, we will save; that is, when the qso array - # has sufficient information for a good QSO. Then the qso-array - # and the input fields are deleted. - elsif ($ch eq KEY_F(2)) { # pressed F2 -> SAVE - ${$_[3]}[$_[2]] = $input; # save field to @qso - if (&saveqso(@{$_[3]}[0..13],$editnr)) { # save @QSO to DB - - &clearinputfields($_[0],1); # clear input fields 0..13 - # Increase serial number in QSO array, clear all other fields - my $snr = ${$_[3]}[14]; - if ($editnr == 0) { - $snr++; - } - @{$_[3]} = ("","","","","","","","","","","","","",""); - ${$_[3]}[14] = $snr; - # Now we actualize the display of the last QSOs in the - # window $wlog. - &lastqsos(\$wlog); - ${$_[5]} = 0; # we finished editing, if we - # did at all. $editnr = 0 - return 4; # success, leave readw, new Q - } # if no success, we continue in the loop. - } - - # exit to the MAIN MENU - elsif ($ch eq KEY_F(1)) { - my $k = 'y'; - - if ($askme && ${$_[3]}[0] ne '') { - $k = &askconfirmation("Really go back to the menu? [y/N]", - 'y|n|\n|\s'); - } - - return 5 if ($k =~ /y/i); # active window = 5 -> MENU - } - - # F3 cancels the current QSO and returns to the CALL input field. - # if $editnr is set (= we edit a QSO), it's set back to 0 - # ask for confirmation if set in config file - elsif ($ch eq KEY_F(3)) { # F3 pressed -> clear QSO - my $k='y'; - - if ($askme) { - $k = &askconfirmation("Really clear this QSO? [y/N]", - 'y|n|\n|\s'); - } - - if ($k =~ /y/i) { - for (0 .. 13) { # iterate through windows 0-13 - addstr(@{$_[0]}[$_],0,0," "x80); # clear it - refresh(@{$_[0]}[$_]); - ${$_[3]}[$_] = ""; # clear QSO array - } - ${$_[5]} = 0; # editqso = 0 - return 4; # return 4 -> to window 0 (call) - } - - } - - # F5 -> get frequency and mode from the transceiver - elsif ($ch eq KEY_F(5)) { # F5 pressed -> freq/mode from rig - - my ($freq, $mode) = ('80', 'CW'); - if (&queryrig(\$freq, \$mode)) { - ${$_[3]}[4] = $freq; - ${$_[3]}[5] = $mode; - - addstr(@{$_[0]}[4],0,0,$freq." "); - addstr(@{$_[0]}[5],0,0,$mode." "); - refresh(@{$_[0]}[4]); - refresh(@{$_[0]}[5]); - } - - return 4; # return 4 because we want back to - } - - # F6 -> open browser with qrz.com info on callsign - elsif ($ch eq KEY_F(6)) { - my $lookup = ${$_[3]}[0]; - unless ($lookup) { $lookup = $input }; - system("$browser http://www.qrz.com/db/$lookup &> /dev/null &"); - } - - # F7 -> go to remote mode for fldigi - elsif ($ch eq KEY_F(7)) { - return 6; - } - - # go to log-window $wlog ($aw = 2) - elsif ($ch eq KEY_F(9)) { - return 2; - } - - # go to prev-QSO-window $wqsos ($aw = 3) - elsif ($ch eq KEY_F(10)) { - return 3; - } - # QUIT YFKlog - elsif ($ch eq KEY_F(12)) { # QUIT - my $k='y'; - - if ($askme && ${$_[3]}[0] ne '') { - $k = &askconfirmation("Really quit YFKlog? [y/N]", - 'y|n|\n|\s'); - } - - if ($k =~ /y/i) { - endwin; # Leave curses mode - system ("killall -9 rigctld"); - print "Thanks for using YFKlog!\n"; - exit; - } - } - } + my $ch; # the getchar() we read + my $win = ${$_[0]}[$_[2]]; # get window to modify + my $input = ${$_[3]}[$_[2]]; # stores what the user entered, + # init from @qso. + my $match = "[a-zA-Z0-9\/]"; # default match expression + my $pos = 0; # cursor position in the field + my $strpos = $pos; # cursor position in the string + my $wlog = ${$_[4]}; # reference to log-windw + my $editnr = ${$_[5]}; # reference to editnr + + my $debug=0; + + my $ovr = $_[6]; # overwrite + my $width = $_[7]; # width is fixed + + # The string length $strlen is used to have entries larger than the width, + # $_[2] is inspected to set the length according to SQL field length. + my $strlen = $width; + if ($_[2] == 0) { $strlen = 15; } # Call + elsif ($_[2] == 5) { $strlen = 6; } # Mode + elsif ($_[2] == 6) { $strlen = 15; } # QTH + elsif ($_[2] == 7) { $strlen = 15; } # Name + elsif ($_[2] == 10) { $strlen = 10; } # RSTs + elsif ($_[2] == 11) { $strlen = 10; } # RSTr + elsif ($_[2] == 12) { $strlen = 60; } # Remarks + elsif ($_[2] == 13) { $strlen = 10; } # PWR + + move($win,0,0); # move cursor to first position + addstr($win,0,0, $input." "x80); # pass $input to window, + refresh($win); + + # For the date, time and band only figures are allowed, + # to achieve this, invoke readw with $_[1] = 1 + if ((defined $_[1]) && ($_[1] == "1")) { # only numbers + $match = '\d'; # set match expression + } + + # For the QSL-status only letters are allowed, + # to achieve this, invoke readw with $_[1] = 2 + if ((defined $_[1]) && ($_[1] == "2")) { # only letters + $match = '[a-zA-Z]'; # set match expression + } + + # For the Name, QTH and Remarks letters, figures and punctuation is allowed + # to achieve this, invoke readw with $_[1] = 3 + if ((defined $_[1]) && ($_[1] == "3")) { + $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # set match expression + } + + # In the BAND-field, numbers and a decimal point are allowed. + if ((defined $_[1]) && ($_[1] == "4")) { + $match = '[0-9.]'; # set match expression + } + + # Now the main loop starts which is waiting for any input from the keyboard + # which is stored in $ch. If it is a valid character that matches $match, + # it will be added to the string $input at the proper place. + # + # If an arrow key LEFT or RIGHT is entered, the position within the string + # $input will be changed, considering that it can only be within + # 0..length($input-1). The position is stored in $pos. + # + # If a control character like a F-Key, Enter or Tab is found, the sub + # exists and $input is written to @qso, with attached information on which + # key was pressed, as ||F1 .. ||F10. This way we can switch to the proper + # window when we get back into the main loop. + + while (1) { # loop infinitely + + $pos-- if ($pos == $width); # keep cursor in field + $strpos-- if ($strpos == $strlen); # stop if string filled + + # If the cursor positions in the field and the string are not the same + # then give only a partial view of the string. + if ($strpos > $pos) { + if (length($input) < $width) { + $pos = $strpos; # perfect, it fits again + } + addstr($win,0,0, substr($input, $strpos-$pos, )." "x80); + } + else { + addstr($win,0,0, $input." "x80); # pass $input to window, + } # delete all after $input. + + move ($win,0,$pos); # move cursor to $pos + refresh($win); # show new window + + $ch = &getch2(); + + # We first check if it is a legal character of the specified $match, + # and if the string will not be too long. + # if so, it will be added to the string (at the proper position!) + if (($ch =~ /^$match$/) && + ((length($input) < $strlen) || ($strpos < $strlen && $ovr)) + ) { + + unless ($_[1] == 3) { # Unless Name, QTH, Remarks + $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase + } + # The new character will be added to $input at the right place. + $strpos++; + $pos++; + + if ($ovr) { + $input = substr($input, 0, $strpos-1).$ch.substr($input, + $strpos > length($input) ? $strpos-1 : $strpos, ); + } + else { + $input = substr($input, 0, $strpos-1).$ch.substr($input, + $strpos-1, ); + } + } + + # The l/r arrow keys change the position of the cursor to left or right + # but only within the boundaries of $input. + + elsif ($ch eq KEY_LEFT) { + if ($pos > 0) { $pos-- } + if ($strpos > 0) { $strpos-- } + } + + elsif ($ch eq KEY_RIGHT) { + if (($pos < length($input)) && ($pos < $width)) { $pos++ } + if ($strpos < length($input)) { $strpos++ } + } + + elsif ($ch eq KEY_HOME) { # Pos1 key + $pos = 0; + $strpos = 0; + } + + elsif ($ch eq KEY_END) { # End key + $strpos = length($input); + if ($strpos >= $strlen) {$strpos = $strlen-1;} + $pos = $strpos; + if ($pos >= $width) {$pos = $width-1;} + } + + elsif (($ch eq KEY_DC) && ($strpos < length($input))) { # Delete key + $input = substr($input, 0, $strpos).substr($input, $strpos+1, ); + } + + # BACKSPACE. When pressing backspace, the character left of the cursor + # is deleted, if it exists. For some reason, KEY_BACKSPACE only is true + # when pressing CTL+H on my system (and all the others I tested); the + # other tests lead to success, although it's probably less portable. + # Found this solution in qe.pl by Wilbert Knol, ZL2BSJ. + + elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) + && ($strpos > 0)) { + $input = substr($input, 0, $strpos-1).substr($input, $strpos, ); + $strpos--; + if ($pos > 0) { $pos--; } + } + + # Space, Tab, keydown and Enter are the keys to go to the next field, + # except in mode $_[1], where it was already caught in the first + # pattern match. If space, tab or newline is found, the sub puts + # $input into the proper place in the @qso array: ${$_[3]}[$_[2]]; + elsif (($ch =~ /^[ \t\n]$/) || $ch eq KEY_DOWN) { + ${$_[3]}[$_[2]] = $input; # save to @qso; + return 1; + } + # Arrow-up or Shift-Tab gues to the previous QSO field. Everything + # else same as above + elsif (($ch eq KEY_UP) || ($ch eq '353')) { # Cursor up or Shift-Tab + ${$_[3]}[$_[2]] = $input; # save to @qso; + return 7; # 6 -> one field back + } + + # If the pressed key was F2, we will save; that is, when the qso array + # has sufficient information for a good QSO. Then the qso-array + # and the input fields are deleted. + elsif ($ch eq KEY_F(2)) { # pressed F2 -> SAVE + ${$_[3]}[$_[2]] = $input; # save field to @qso + if (&saveqso(@{$_[3]}[0..13],$editnr)) { # save @QSO to DB + + &clearinputfields($_[0],1); # clear input fields 0..13 + # Increase serial number in QSO array, clear all other fields + my $snr = ${$_[3]}[14]; + if ($editnr == 0) { + $snr++; + } + @{$_[3]} = ("","","","","","","","","","","","","",""); + ${$_[3]}[14] = $snr; + # Now we actualize the display of the last QSOs in the + # window $wlog. + &lastqsos(\$wlog); + ${$_[5]} = 0; # we finished editing, if we + # did at all. $editnr = 0 + return 4; # success, leave readw, new Q + } # if no success, we continue in the loop. + } + + # exit to the MAIN MENU + elsif ($ch eq KEY_F(1)) { + my $k = 'y'; + + if ($askme && ${$_[3]}[0] ne '') { + $k = &askconfirmation("Really go back to the menu? [y/N]", + 'y|n|\n|\s'); + } + + return 5 if ($k =~ /y/i); # active window = 5 -> MENU + } + + # F3 cancels the current QSO and returns to the CALL input field. + # if $editnr is set (= we edit a QSO), it's set back to 0 + # ask for confirmation if set in config file + elsif ($ch eq KEY_F(3)) { # F3 pressed -> clear QSO + my $k='y'; + + if ($askme) { + $k = &askconfirmation("Really clear this QSO? [y/N]", + 'y|n|\n|\s'); + } + + if ($k =~ /y/i) { + for (0 .. 13) { # iterate through windows 0-13 + addstr(@{$_[0]}[$_],0,0," "x80); # clear it + refresh(@{$_[0]}[$_]); + ${$_[3]}[$_] = ""; # clear QSO array + } + ${$_[5]} = 0; # editqso = 0 + return 4; # return 4 -> to window 0 (call) + } + + } + + # F5 -> get frequency and mode from the transceiver + elsif ($ch eq KEY_F(5)) { # F5 pressed -> freq/mode from rig + + my ($freq, $mode) = ('80', 'CW'); + if (&queryrig(\$freq, \$mode)) { + ${$_[3]}[4] = $freq; + ${$_[3]}[5] = $mode; + + addstr(@{$_[0]}[4],0,0,$freq." "); + addstr(@{$_[0]}[5],0,0,$mode." "); + refresh(@{$_[0]}[4]); + refresh(@{$_[0]}[5]); + } + + return 4; # return 4 because we want back to + } + + # F6 -> open browser with qrz.com info on callsign + elsif ($ch eq KEY_F(6)) { + my $lookup = ${$_[3]}[0]; + unless ($lookup) { $lookup = $input }; + system("$browser http://www.qrz.com/db/$lookup &> /dev/null &"); + } + + # F7 -> go to remote mode for fldigi + elsif ($ch eq KEY_F(7)) { + return 6; + } + + # go to log-window $wlog ($aw = 2) + elsif ($ch eq KEY_F(9)) { + return 2; + } + + # go to prev-QSO-window $wqsos ($aw = 3) + elsif ($ch eq KEY_F(10)) { + return 3; + } + # QUIT YFKlog + elsif ($ch eq KEY_F(12)) { # QUIT + my $k='y'; + + if ($askme && ${$_[3]}[0] ne '') { + $k = &askconfirmation("Really quit YFKlog? [y/N]", + 'y|n|\n|\s'); + } + + if ($k =~ /y/i) { + endwin; # Leave curses mode + system ("killall -9 rigctld"); + print "Thanks for using YFKlog!\n"; + exit; + } + } + } } ############################################################################## @@ -1245,70 +1245,70 @@ sub readw { ############################################################################## sub lastqsos { - my $wlog = ${$_[0]}; # reference to $wlog window - my $nr; # nr of QSOs to display - my $y; # y-position in window - my $by = " `NR` DESC "; - - if ($logsort eq 'C') { - $by = " `DATE` DESC, `T_ON` DESC "; - } - - if ($screenlayout == 0) { # original screen layout, 16 QSOs, small - $nr = 16; - $y=15; # y-position in $wlog - } - elsif ($screenlayout == 1) { # windows above each other, 8 QSOs - $nr = ($main::row - 8)/2; - $y = $nr - 1; # y-position in $wlog - } - - # Now we fetch the last x QSOs in the database, only CALL, BAND, MODE and - # date needed. - my $l = $dbh->prepare("SELECT `CALL`, `BAND`, `MODE`, `DATE`, `T_ON`, - `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLS`, `QSLR`, `QSLRL` FROM - log_$mycall - ORDER BY $by LIMIT $nr"); - $l->execute(); - # temporary vars - my ($call, $band, $mode, $date, $time, $name, $qth, $rsts, - $rstr,$qsls,$qslr, $qslrl); - $l->bind_columns(\$call, \$band, \$mode, \$date,\$time, \$name,\$qth, - \$rsts,\$rstr,\$qsls,\$qslr, \$qslrl); - while ($l->fetch()) { # while row available - # we put the date into DD-MM-YY format from YYYY-MM-DD - $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); - # cut Call, Name, QTH, RSTR, RSTS, mode, if needed - $call = substr($call,0,12); - $name = substr($name,0,8); - $qth = substr($qth,0,13); - $rstr = substr($rstr,0,3); - $rsts = substr($rsts,0,3); - $mode = substr($mode,0,5); - - if ($screenlayout == 0) { - addstr($wlog,$y,0, sprintf("%-12s%-4s %-5s%-6s", - $call,$band,$mode,$date)); - } - elsif ($screenlayout == 1) { - substr($time,-3,)=''; # remove seconds - addstr($wlog,$y,0, - sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", - $call,$band,$mode,$time,$date,$name,$qth,$rsts,$rstr, - $qsls, $qslr, $qslrl)); - } - $y--; # move one row up - } - # If there were less than 16 QSOs in the log, the remaining lines have to - # be filled with spaces - if ($y > 0) { - for $y (0 .. $y) { - addstr($wlog,$y,0, " "x30) if ($screenlayout == 0); - addstr($wlog,$y,0, " "x80) if ($screenlayout == 1); - } - } - - refresh($wlog); + my $wlog = ${$_[0]}; # reference to $wlog window + my $nr; # nr of QSOs to display + my $y; # y-position in window + my $by = " `NR` DESC "; + + if ($logsort eq 'C') { + $by = " `DATE` DESC, `T_ON` DESC "; + } + + if ($screenlayout == 0) { # original screen layout, 16 QSOs, small + $nr = 16; + $y=15; # y-position in $wlog + } + elsif ($screenlayout == 1) { # windows above each other, 8 QSOs + $nr = ($main::row - 8)/2; + $y = $nr - 1; # y-position in $wlog + } + + # Now we fetch the last x QSOs in the database, only CALL, BAND, MODE and + # date needed. + my $l = $dbh->prepare("SELECT `CALL`, `BAND`, `MODE`, `DATE`, `T_ON`, + `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLS`, `QSLR`, `QSLRL` FROM + log_$mycall + ORDER BY $by LIMIT $nr"); + $l->execute(); + # temporary vars + my ($call, $band, $mode, $date, $time, $name, $qth, $rsts, + $rstr,$qsls,$qslr, $qslrl); + $l->bind_columns(\$call, \$band, \$mode, \$date,\$time, \$name,\$qth, + \$rsts,\$rstr,\$qsls,\$qslr, \$qslrl); + while ($l->fetch()) { # while row available + # we put the date into DD-MM-YY format from YYYY-MM-DD + $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); + # cut Call, Name, QTH, RSTR, RSTS, mode, if needed + $call = substr($call,0,12); + $name = substr($name,0,8); + $qth = substr($qth,0,13); + $rstr = substr($rstr,0,3); + $rsts = substr($rsts,0,3); + $mode = substr($mode,0,5); + + if ($screenlayout == 0) { + addstr($wlog,$y,0, sprintf("%-12s%-4s %-5s%-6s", + $call,$band,$mode,$date)); + } + elsif ($screenlayout == 1) { + substr($time,-3,)=''; # remove seconds + addstr($wlog,$y,0, + sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", + $call,$band,$mode,$time,$date,$name,$qth,$rsts,$rstr, + $qsls, $qslr, $qslrl)); + } + $y--; # move one row up + } + # If there were less than 16 QSOs in the log, the remaining lines have to + # be filled with spaces + if ($y > 0) { + for $y (0 .. $y) { + addstr($wlog,$y,0, " "x30) if ($screenlayout == 0); + addstr($wlog,$y,0, " "x80) if ($screenlayout == 1); + } + } + + refresh($wlog); } @@ -1323,342 +1323,342 @@ sub lastqsos { ############################################################################## sub callinfo { - my $call = ${$_[0]}[0]; # callsign to analyse - my $band = ${$_[0]}[4]; # band of the current QSO - my $dxwin = $_[1]; # window where to print DXCC/Pfx - my @wi = @{$_[2]}; # reference to input-windows - my $wqsos = $_[3]; # qso-b4-window - my $editnr = $_[4]; # if we edit a QSO, we don't query the RIG - my $prefix = &wpx($call); # determine the Prefix - my $PI=3.14159265; # PI for the distance and bearing - my $RE=6371; # Earth radius - my $z =180/$PI; # Just to reduce typing in formular dist/dir - my $foundlog = 0; - - my $ascdesc = ' ASC '; - - if ($prevsort eq 'D') { - $ascdesc = ' DESC '; - } - - if (defined $prefix) { # &wpx returns undef when callsign is invalid - # Now we print all the fields to their appropriate locations, with - # added whitespaces behind it so any previous entries will be - # overwritten. - my @dxcc = &dxcc($call); # dxcc array gets filled + my $call = ${$_[0]}[0]; # callsign to analyse + my $band = ${$_[0]}[4]; # band of the current QSO + my $dxwin = $_[1]; # window where to print DXCC/Pfx + my @wi = @{$_[2]}; # reference to input-windows + my $wqsos = $_[3]; # qso-b4-window + my $editnr = $_[4]; # if we edit a QSO, we don't query the RIG + my $prefix = &wpx($call); # determine the Prefix + my $PI=3.14159265; # PI for the distance and bearing + my $RE=6371; # Earth radius + my $z =180/$PI; # Just to reduce typing in formular dist/dir + my $foundlog = 0; + + my $ascdesc = ' ASC '; + + if ($prevsort eq 'D') { + $ascdesc = ' DESC '; + } + + if (defined $prefix) { # &wpx returns undef when callsign is invalid + # Now we print all the fields to their appropriate locations, with + # added whitespaces behind it so any previous entries will be + # overwritten. + my @dxcc = &dxcc($call); # dxcc array gets filled my $sprefix = substr($prefix, 0, 5); - addstr($dxwin, 0,9, $dxcc[0]." " x (25-length($dxcc[0]))); - addstr($dxwin, 0,40, $dxcc[7]." " x (5-length($dxcc[7]))); - addstr($dxwin, 0,51, $sprefix." " x (5-length($sprefix))); - addstr($dxwin, 0,61, $dxcc[2]." " x (2-length($dxcc[2]))); - addstr($dxwin, 0,69, $dxcc[1]." " x (2-length($dxcc[1]))); - addstr($dxwin, 1,5, $dxcc[4]." " x (7-length($dxcc[4]))); - addstr($dxwin, 1,19, $dxcc[5]." " x (7-length($dxcc[5]))); - - my $lat2 = $dxcc[4]; # to save typing work :-) - my $lon2 = $dxcc[5]; - - # g is the "distance angle", 0 .. pi - my $g = acos(sin($lat1/$z)*sin($lat2/$z)+cos($lat1/$z)*cos($lat2/$z)* - cos(($lon2-$lon1)/$z)); - # The distance is $g * $RE - my $dist = $g * $RE; - - # Direction - my $dir = 0; - - unless ($dist == 0) { - $dir = acos((sin($lat2/$z)-sin($lat1/$z)*cos($g))/ - (cos($lat1/$z)*sin($g)))*360/(2*$PI); - } - - # Shortpath - if (sin(($lon2-$lon1)/$z) < 0) { $dir = 360 - $dir;} - $dir = 360 - $dir; - - addstr($dxwin, 1,38, sprintf("%-6d",$dist)); - addstr($dxwin, 1,58, sprintf("%3d",$dir)); - - # now we have to get the home-call to get the name, previous QSOs any - # maybe (TBD) award data from the station. We split the callsign at - # every / (if any), and then take the longest part as homecall. of - # course such exotic calls as KH5K/K1A would get the wrong result but I - # do not care :) - - my @call = split(/\//, $call); - my $length=0; # length of splitted part - foreach(@call) { # chose longest part - if (length($_) >= $length) { - $length = length($_); - $call = $_; - } - } - - # We fetch the name and the qth (if available) from the database. - - my $nq = $dbh->prepare("SELECT NAME, QTH from calls WHERE - `CALL`='$call'"); - $nq->execute(); - my ($name, $qth); # temporary vars - $nq->bind_columns(\$name, \$qth); # bind references - if ($nq->fetch()) { # if name available - unless (${$_[0]}[7] ne '') { # and no name in $qso - ${$_[0]}[7] = $name; # save to @qso - addstr($wi[7],0,0,"$name"); # put into window - } - unless (${$_[0]}[6] ne '') { # and no QTH in $qso - ${$_[0]}[6] = $qth; # save to @qso - addstr($wi[6],0,0,"$qth"); # put into window - } - refresh($wi[6]); - refresh($wi[7]); - $foundlog = 1; - } - - - # Now the previous QSOs with the station will be displayed. A database - # query is made for: CALL (because it might have been something - # different than the homecall, like PA/DJ1YFK/p, DATE, time, band, - # mode, QSL sent and QSL-rx. - # (TBD maybe it would be worth thinking about adding an additional - # column for the own call and then specify a list of logs to search in - # the config file) - - # Select all QSOs where the base-callsign is $call (which is the base - # call of the current QSO) - - my $nbr; # different layouts - if ($screenlayout == 0) {$nbr=16;} - if ($screenlayout == 1) { + addstr($dxwin, 0,9, $dxcc[0]." " x (25-length($dxcc[0]))); + addstr($dxwin, 0,40, $dxcc[7]." " x (5-length($dxcc[7]))); + addstr($dxwin, 0,51, $sprefix." " x (5-length($sprefix))); + addstr($dxwin, 0,61, $dxcc[2]." " x (2-length($dxcc[2]))); + addstr($dxwin, 0,69, $dxcc[1]." " x (2-length($dxcc[1]))); + addstr($dxwin, 1,5, $dxcc[4]." " x (7-length($dxcc[4]))); + addstr($dxwin, 1,19, $dxcc[5]." " x (7-length($dxcc[5]))); + + my $lat2 = $dxcc[4]; # to save typing work :-) + my $lon2 = $dxcc[5]; + + # g is the "distance angle", 0 .. pi + my $g = acos(sin($lat1/$z)*sin($lat2/$z)+cos($lat1/$z)*cos($lat2/$z)* + cos(($lon2-$lon1)/$z)); + # The distance is $g * $RE + my $dist = $g * $RE; + + # Direction + my $dir = 0; + + unless ($dist == 0) { + $dir = acos((sin($lat2/$z)-sin($lat1/$z)*cos($g))/ + (cos($lat1/$z)*sin($g)))*360/(2*$PI); + } + + # Shortpath + if (sin(($lon2-$lon1)/$z) < 0) { $dir = 360 - $dir;} + $dir = 360 - $dir; + + addstr($dxwin, 1,38, sprintf("%-6d",$dist)); + addstr($dxwin, 1,58, sprintf("%3d",$dir)); + + # now we have to get the home-call to get the name, previous QSOs any + # maybe (TBD) award data from the station. We split the callsign at + # every / (if any), and then take the longest part as homecall. of + # course such exotic calls as KH5K/K1A would get the wrong result but I + # do not care :) + + my @call = split(/\//, $call); + my $length=0; # length of splitted part + foreach(@call) { # chose longest part + if (length($_) >= $length) { + $length = length($_); + $call = $_; + } + } + + # We fetch the name and the qth (if available) from the database. + + my $nq = $dbh->prepare("SELECT NAME, QTH from calls WHERE + `CALL`='$call'"); + $nq->execute(); + my ($name, $qth); # temporary vars + $nq->bind_columns(\$name, \$qth); # bind references + if ($nq->fetch()) { # if name available + unless (${$_[0]}[7] ne '') { # and no name in $qso + ${$_[0]}[7] = $name; # save to @qso + addstr($wi[7],0,0,"$name"); # put into window + } + unless (${$_[0]}[6] ne '') { # and no QTH in $qso + ${$_[0]}[6] = $qth; # save to @qso + addstr($wi[6],0,0,"$qth"); # put into window + } + refresh($wi[6]); + refresh($wi[7]); + $foundlog = 1; + } + + + # Now the previous QSOs with the station will be displayed. A database + # query is made for: CALL (because it might have been something + # different than the homecall, like PA/DJ1YFK/p, DATE, time, band, + # mode, QSL sent and QSL-rx. + # (TBD maybe it would be worth thinking about adding an additional + # column for the own call and then specify a list of logs to search in + # the config file) + + # Select all QSOs where the base-callsign is $call (which is the base + # call of the current QSO) + + my $nbr; # different layouts + if ($screenlayout == 0) {$nbr=16;} + if ($screenlayout == 1) { $nbr = ($main::row - 8)/2; } - # First count... - my $lqcount = $dbh->prepare("SELECT count(*) FROM log_$mycall WHERE - `CALL` = '$call' OR `CALL` LIKE '\%/$call' OR - `CALL` LIKE '\%/$call/\%' OR `CALL` LIKE '$call/\%';"); - $lqcount->execute(); - - my $count = $lqcount->fetchrow_array(); - - my $lq = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `BAND`, `MODE`, - `QSLS`, `QSLR`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLRL` from - log_$mycall - WHERE `CALL` = '$call' OR - `CALL` LIKE '\%/$call' OR - `CALL` LIKE '\%/$call/\%' OR - `CALL` LIKE '$call/\%' - ORDER BY `DATE` $ascdesc, `T_ON` $ascdesc;"); - $lq->execute(); - my ($lcall, $ldate, $ltime, $lband, $lmode, $lqsls, $lqslr, $lname, - $lqth, $lrsts, $lrstr, $lqslrl); - $lq->bind_columns(\$lcall, \$ldate, \$ltime, \$lband, \$lmode, \$lqsls, - \$lqslr, \$lname, \$lqth, \$lrsts, \$lrstr, \$lqslrl); - my $y = 0; - while ($lq->fetch()) { # more QSOs available - $ltime = substr($ltime, 0,5); # cut seconds from time - $ldate = substr($ldate,8,2).substr($ldate,4,4).substr($ldate,2,2); - # cut Call, Name, QTH, RSTR, RSTS, Mode - $lcall = substr($lcall,0,12); - $lname = substr($lname,0,8); - $lqth = substr($lqth,0,13); - $lrstr = substr($lrstr,0,3); - $lrsts = substr($lrsts,0,3); - $lmode = substr($lmode,0,5); - - my $line; - if ($screenlayout == 0) { - $line = sprintf("%-14s %-8s %-5s %4s %-4s %1s %1s %1s ", - $lcall, $ldate, $ltime, $lband, $lmode, $lqsls, $lqslr,$lqslrl); - } - elsif ($screenlayout ==1) { - $line = sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", - $lcall,$lband,$lmode,$ltime,$ldate,$lname,$lqth,$lrsts, - $lrstr, $lqsls, $lqslr, $lqslrl); - } - - addstr($wqsos, $y, 0, $line); - ($y < $nbr) ? $y++ : last; # prints first 16 rows - } # all QSOs printed - for (;$y < $nbr;$y++) { # for the remaining rows - addstr($wqsos, $y, 0, " "x80); # fill with whitespace - } - if ($count > ($nbr-1)) { # more QSOs than fit in window - my $x; # x-position of msg, depending on width - if ($screenlayout == 0) { - $x = 47; # TODO maybe with getxy? - } - elsif ($screenlayout == 1) { - $x=77; - } - - addstr($wqsos, ($nbr-2), $x, ($count-$nbr)); - addstr($wqsos, ($nbr-1), $x-1, "more"); - } - refresh($wqsos); - - # We fetch club membership information from the database ... - # As of version 0.2.3: Also check other logbooks for the callsign - # as given in .yfklog for previous QSOs. See .yfktest or MANUAL. - - my $clubline=''; # We will store the club infos here - - my $clubs = $dbh->prepare("SELECT `CLUB`, `NR` FROM clubs WHERE - `CALL`='$call'"); - $clubs->execute(); - - while (my @a = $clubs->fetchrow_array()) { # fetch row - $clubline .= $a[0].":".$a[1]." "; # assemble string - } - # Output will be something like: AGCW:2666 HSC:1754 ... - - # now previous QSOs: - - my $qsoinotherlogs=''; - - $checklogs =~ s#/#_#g; - my @calls = split(/\s+/, "\L$checklogs"); - - foreach my $callsign (@calls) { - my $sth = $dbh->prepare("SELECT `CALL` FROM log_$callsign WHERE - `CALL` = '$call' OR - `CALL` LIKE '\%\/$call' OR - `CALL` LIKE '\%\/$call\/\%' OR - `CALL` LIKE '$call\/\%' - "); # No more regex with SQlite.. - $sth->execute(); - if ($sth->fetch()) { - $qsoinotherlogs.= "\U$callsign " unless ($callsign eq $mycall); - } - - } - - if ($qsoinotherlogs ne '') { - $qsoinotherlogs =~ s#_#/#g; - $clubline .= 'Wkd as: '.$qsoinotherlogs; - } - - ########################################## - # Show DXCC bandpoints for the $call, also add to club-line. if new - # DXCC or bandpoint, give extra notice. - - my $dx = $dbh->prepare("SELECT count(*) from log_$mycall WHERE - DXCC='$dxcc[7]';"); - $dx->execute(); - - my $newdxcc = $dx->fetchrow_array(); - - if ($newdxcc) { # DXCC already wkd, show bands - $dx = $dbh->prepare("SELECT `band`, `qslr`, `QSLRL` from - log_$mycall WHERE - DXCC='$dxcc[7]';"); - - $dx->execute(); - - my %bandhash; - my @i; - - while (@i = $dx->fetchrow_array()) { - if ($i[2] eq 'Y') { $i[1] = 'Y' } # LOTW = paper - unless(defined($bandhash{$i[0]}) && $bandhash{$i[0]} ne 'N') { - $bandhash{$i[0]} = $i[1]; - } - } - - my $j; - my $string=''; - - foreach $j (sort {$a <=> $b} keys %bandhash) { - $string .= "$j$bandhash{$j} "; - } - - $string =~ s/Y/C/g; - $string =~ s/N/W/g; - - $clubline .= $string; - - # bandpoint? - - unless ($string =~ /\b$band()[A-Z]\b/) { - addstr($dxwin, 1, 65, "New Band!"); - } - else { - addstr($dxwin, 1, 65, " "); - } - } - else { # NEW DXCC - addstr($dxwin, 1, 65, "New DXCC!"); - } - - addstr($dxwin, 2, 0, sprintf("%-80s", $clubline)); - refresh($dxwin); - } - - ########################################################## - # Query rig if autoqueryrig = 1 and NO QSO being edited. - ########################################################## - if ($autoqueryrig && !$editnr) { - - my ($band, $mode) = (${$_[0]}[4] , ${$_[0]}[5]); - - &queryrig(\$band, \$mode); - - ${$_[0]}[4] = $band; - ${$_[0]}[5] = $mode; - - addstr($wi[4],0,0,$band." "); - addstr($wi[5],0,0,$mode." "); - refresh($wi[4]); - refresh($wi[5]); - } - - if ($usehamdb && $hamdb) { - my $results = $hamdb->lookup(uc($call)); - if ($results && $#$results > -1) { - my $result = $results->[0]; # just get the first - - # assume that if we previously logged them the previous logged name - # is right. - if (!$foundlog) { - my $nm = $result->{'first_name'} . " " . $result->{'last_name'}; - ${$_[0]}[7] = $nm; - addstr($wi[7],0,0,$nm); - refresh($wi[7]); - } - - # assume the QTH may have moved though, so use the new one - my $qth = $result->{'qth'}; - ${$_[0]}[6] = $qth; - addstr($wi[6],0,0,$qth); - refresh($wi[6]); - - my $remarks = ""; - - # remarks - - # class - if (defined($result->{'operator_class'})) { - $remarks .= "Cl: $result->{'operator_class'}"; - } - - # GRID - if (defined($result->{'Grid'})) { - $remarks .= " GRID:$result->{'Grid'}"; - } - - if (defined($result->{'State'})) { - $remarks .= " STATE:$result->{'State'}"; - } elsif ($result->{'Addr2'} =~ /[^,],\s*([^,]+)/) { - $remarks .= " STATE:$1"; - } - - if ($remarks ne '') { - ${$_[0]}[12] = $remarks; - addstr($wi[12],0,0,$remarks); - refresh($wi[12]); - } - } - } + # First count... + my $lqcount = $dbh->prepare("SELECT count(*) FROM log_$mycall WHERE + `CALL` = '$call' OR `CALL` LIKE '\%/$call' OR + `CALL` LIKE '\%/$call/\%' OR `CALL` LIKE '$call/\%';"); + $lqcount->execute(); + + my $count = $lqcount->fetchrow_array(); + + my $lq = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `BAND`, `MODE`, + `QSLS`, `QSLR`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLRL` from + log_$mycall + WHERE `CALL` = '$call' OR + `CALL` LIKE '\%/$call' OR + `CALL` LIKE '\%/$call/\%' OR + `CALL` LIKE '$call/\%' + ORDER BY `DATE` $ascdesc, `T_ON` $ascdesc;"); + $lq->execute(); + my ($lcall, $ldate, $ltime, $lband, $lmode, $lqsls, $lqslr, $lname, + $lqth, $lrsts, $lrstr, $lqslrl); + $lq->bind_columns(\$lcall, \$ldate, \$ltime, \$lband, \$lmode, \$lqsls, + \$lqslr, \$lname, \$lqth, \$lrsts, \$lrstr, \$lqslrl); + my $y = 0; + while ($lq->fetch()) { # more QSOs available + $ltime = substr($ltime, 0,5); # cut seconds from time + $ldate = substr($ldate,8,2).substr($ldate,4,4).substr($ldate,2,2); + # cut Call, Name, QTH, RSTR, RSTS, Mode + $lcall = substr($lcall,0,12); + $lname = substr($lname,0,8); + $lqth = substr($lqth,0,13); + $lrstr = substr($lrstr,0,3); + $lrsts = substr($lrsts,0,3); + $lmode = substr($lmode,0,5); + + my $line; + if ($screenlayout == 0) { + $line = sprintf("%-14s %-8s %-5s %4s %-4s %1s %1s %1s ", + $lcall, $ldate, $ltime, $lband, $lmode, $lqsls, $lqslr,$lqslrl); + } + elsif ($screenlayout ==1) { + $line = sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", + $lcall,$lband,$lmode,$ltime,$ldate,$lname,$lqth,$lrsts, + $lrstr, $lqsls, $lqslr, $lqslrl); + } + + addstr($wqsos, $y, 0, $line); + ($y < $nbr) ? $y++ : last; # prints first 16 rows + } # all QSOs printed + for (;$y < $nbr;$y++) { # for the remaining rows + addstr($wqsos, $y, 0, " "x80); # fill with whitespace + } + if ($count > ($nbr-1)) { # more QSOs than fit in window + my $x; # x-position of msg, depending on width + if ($screenlayout == 0) { + $x = 47; # TODO maybe with getxy? + } + elsif ($screenlayout == 1) { + $x=77; + } + + addstr($wqsos, ($nbr-2), $x, ($count-$nbr)); + addstr($wqsos, ($nbr-1), $x-1, "more"); + } + refresh($wqsos); + + # We fetch club membership information from the database ... + # As of version 0.2.3: Also check other logbooks for the callsign + # as given in .yfklog for previous QSOs. See .yfktest or MANUAL. + + my $clubline=''; # We will store the club infos here + + my $clubs = $dbh->prepare("SELECT `CLUB`, `NR` FROM clubs WHERE + `CALL`='$call'"); + $clubs->execute(); + + while (my @a = $clubs->fetchrow_array()) { # fetch row + $clubline .= $a[0].":".$a[1]." "; # assemble string + } + # Output will be something like: AGCW:2666 HSC:1754 ... + + # now previous QSOs: + + my $qsoinotherlogs=''; + + $checklogs =~ s#/#_#g; + my @calls = split(/\s+/, "\L$checklogs"); + + foreach my $callsign (@calls) { + my $sth = $dbh->prepare("SELECT `CALL` FROM log_$callsign WHERE + `CALL` = '$call' OR + `CALL` LIKE '\%\/$call' OR + `CALL` LIKE '\%\/$call\/\%' OR + `CALL` LIKE '$call\/\%' + "); # No more regex with SQlite.. + $sth->execute(); + if ($sth->fetch()) { + $qsoinotherlogs.= "\U$callsign " unless ($callsign eq $mycall); + } + + } + + if ($qsoinotherlogs ne '') { + $qsoinotherlogs =~ s#_#/#g; + $clubline .= 'Wkd as: '.$qsoinotherlogs; + } + + ########################################## + # Show DXCC bandpoints for the $call, also add to club-line. if new + # DXCC or bandpoint, give extra notice. + + my $dx = $dbh->prepare("SELECT count(*) from log_$mycall WHERE + DXCC='$dxcc[7]';"); + $dx->execute(); + + my $newdxcc = $dx->fetchrow_array(); + + if ($newdxcc) { # DXCC already wkd, show bands + $dx = $dbh->prepare("SELECT `band`, `qslr`, `QSLRL` from + log_$mycall WHERE + DXCC='$dxcc[7]';"); + + $dx->execute(); + + my %bandhash; + my @i; + + while (@i = $dx->fetchrow_array()) { + if ($i[2] eq 'Y') { $i[1] = 'Y' } # LOTW = paper + unless(defined($bandhash{$i[0]}) && $bandhash{$i[0]} ne 'N') { + $bandhash{$i[0]} = $i[1]; + } + } + + my $j; + my $string=''; + + foreach $j (sort {$a <=> $b} keys %bandhash) { + $string .= "$j$bandhash{$j} "; + } + + $string =~ s/Y/C/g; + $string =~ s/N/W/g; + + $clubline .= $string; + + # bandpoint? + + unless ($string =~ /\b$band()[A-Z]\b/) { + addstr($dxwin, 1, 65, "New Band!"); + } + else { + addstr($dxwin, 1, 65, " "); + } + } + else { # NEW DXCC + addstr($dxwin, 1, 65, "New DXCC!"); + } + + addstr($dxwin, 2, 0, sprintf("%-80s", $clubline)); + refresh($dxwin); + } + + ########################################################## + # Query rig if autoqueryrig = 1 and NO QSO being edited. + ########################################################## + if ($autoqueryrig && !$editnr) { + + my ($band, $mode) = (${$_[0]}[4] , ${$_[0]}[5]); + + &queryrig(\$band, \$mode); + + ${$_[0]}[4] = $band; + ${$_[0]}[5] = $mode; + + addstr($wi[4],0,0,$band." "); + addstr($wi[5],0,0,$mode." "); + refresh($wi[4]); + refresh($wi[5]); + } + + if ($usehamdb && $hamdb) { + my $results = $hamdb->lookup(uc($call)); + if ($results && $#$results > -1) { + my $result = $results->[0]; # just get the first + + # assume that if we previously logged them the previous logged name + # is right. + if (!$foundlog) { + my $nm = $result->{'first_name'} . " " . $result->{'last_name'}; + ${$_[0]}[7] = $nm; + addstr($wi[7],0,0,$nm); + refresh($wi[7]); + } + + # assume the QTH may have moved though, so use the new one + my $qth = $result->{'qth'}; + ${$_[0]}[6] = $qth; + addstr($wi[6],0,0,$qth); + refresh($wi[6]); + + my $remarks = ""; + + # remarks + + # class + if (defined($result->{'operator_class'})) { + $remarks .= "Cl: $result->{'operator_class'}"; + } + + # GRID + if (defined($result->{'Grid'})) { + $remarks .= " GRID:$result->{'Grid'}"; + } + + if (defined($result->{'State'})) { + $remarks .= " STATE:$result->{'State'}"; + } elsif ($result->{'Addr2'} =~ /[^,],\s*([^,]+)/) { + $remarks .= " STATE:$1"; + } + + if ($remarks ne '') { + ${$_[0]}[12] = $remarks; + addstr($wi[12],0,0,$remarks); + refresh($wi[12]); + } + } + } } @@ -1668,16 +1668,16 @@ sub callinfo { ############################################################################## sub getdate { - my @date = gmtime(); # $date[3] has day, 4 month, 5 year - - # The year is in years from 1900, month is counting from 0 from january. - # Thus month++ and year += 1900; - $date[4] += 1; - if ($date[3] < 10) { $date[3] = "0".$date[3]; } # add leading zero - if ($date[4] < 10) { $date[4] = "0".$date[4]; } - my $date = $date[3].$date[4].($date[5] + 1900); - - return $date; + my @date = gmtime(); # $date[3] has day, 4 month, 5 year + + # The year is in years from 1900, month is counting from 0 from january. + # Thus month++ and year += 1900; + $date[4] += 1; + if ($date[3] < 10) { $date[3] = "0".$date[3]; } # add leading zero + if ($date[4] < 10) { $date[4] = "0".$date[4]; } + my $date = $date[3].$date[4].($date[5] + 1900); + + return $date; } ############################################################################## @@ -1685,10 +1685,10 @@ sub getdate { ############################################################################## sub gettime { - my @date = gmtime(); # $date[2] has hour, 1 has minutes - if ($date[1] < 10) { $date[1] = "0".$date[1]; } # Add 0 if neccessary - if ($date[2] < 10) { $date[2] = "0".$date[2]; } - return $date[2].$date[1]; + my @date = gmtime(); # $date[2] has hour, 1 has minutes + if ($date[1] < 10) { $date[1] = "0".$date[1]; } # Add 0 if neccessary + if ($date[2] < 10) { $date[2] = "0".$date[2]; } + return $date[2].$date[1]; } ############################################################################## @@ -1696,8 +1696,8 @@ sub gettime { ############################################################################## sub splashscreen { - my $yfkver = $_[0]; - return "YFKlog v$yfkver - a general purpose ham radio logbook + my $yfkver = $_[0]; + return "YFKlog v$yfkver - a general purpose ham radio logbook Copyright (C) 2005-2008 Fabian Kurz, DJ1YFK @@ -1718,185 +1718,185 @@ return 1; ############################################################################## sub choseqso { - my $wlog = ${$_[0]}; # reference to $wlog window - my $offset=0; # offset for DB query. - my $aline; # active line, cursor position. - my $ch; # character we get from keyboard - my $ret=0; # return value. saves the NR from the - # database which suits in $aline - my $goon=1; # "go on" in the do .. while loop - my $nbr; # nr of lines/qsos - my $y; # y-position for printing in $wlog - my $totalcalls=0; # might be 0, then return - - my $by = " `NR` DESC "; - - if ($logsort eq 'C') { - $by = " `DATE` DESC, `T_ON` DESC "; - } - - # set active (highlighted) line according to screen layout - if ($screenlayout == 0) { - $aline = 15; - $nbr = 16; - } - elsif ($screenlayout == 1) { - $nbr = ($main::row-8)/2; - $aline=$nbr-1; - } - - + my $wlog = ${$_[0]}; # reference to $wlog window + my $offset=0; # offset for DB query. + my $aline; # active line, cursor position. + my $ch; # character we get from keyboard + my $ret=0; # return value. saves the NR from the + # database which suits in $aline + my $goon=1; # "go on" in the do .. while loop + my $nbr; # nr of lines/qsos + my $y; # y-position for printing in $wlog + my $totalcalls=0; # might be 0, then return + + my $by = " `NR` DESC "; + + if ($logsort eq 'C') { + $by = " `DATE` DESC, `T_ON` DESC "; + } + + # set active (highlighted) line according to screen layout + if ($screenlayout == 0) { + $aline = 15; + $nbr = 16; + } + elsif ($screenlayout == 1) { + $nbr = ($main::row-8)/2; + $aline=$nbr-1; + } + + # Now we fetch 16/8 QSOs from the database, eventually with an offset when we # scrolled. only NR, CALL, BAND, MODE and DATE needed. # a do {..} while construct is used because we need a highlighted line right at # the start, without any extra key pressed -do { # loop and get keyboard input - - # after every keystroke the database query is done again and the active - # line displayed in another color. unfortunately chgat() does not work on - # things that have already been sent to the display with refresh(), so only - # colouring one line while scrolling is not possible. since I was too lazy - # to save the 16/8 QSOs into some kind of array, I decided to do the query - # every time again. no performance problems even on my old K6-300. - - my $cq = $dbh->prepare("SELECT `NR`, `CALL`, `BAND`, `MODE`, `DATE`, - `T_ON`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLS`, `QSLR`, `QSLRL` FROM - log_$mycall ORDER BY $by LIMIT $offset, $nbr"); - $cq->execute(); - -# my $nrofrows = $cq->execute(); - -# if ($nrofrows eq "0E0") { return "i"; } # nothing, back to log input - - # temporary vars - my ($nr, $call, $band, $mode, $date, $time, $name, $qth, $rsts, - $rstr,$qsls,$qslr, $qslrl); - $cq->bind_columns(\$nr, \$call, \$band, \$mode, \$date,\$time, \$name, - \$qth,\$rsts,\$rstr,\$qsls,\$qslr, \$qslrl); - $y = ($nbr-1); - my $callsthispage=0; # calls displayed on this page - while ($cq->fetch()) { # while row available - $callsthispage++; - $totalcalls++; - # we put the date into DD-MM-YY format from YYYY-MM-DD - $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); - # cut Call, Name, QTH, RSTR, RSTS, Mode - $call = substr($call,0,12); - $name = substr($name,0,8); - $qth = substr($qth,0,13); - $rstr = substr($rstr,0,3); - $rsts = substr($rsts,0,3); - $mode = substr($mode,0,5); - - if ($y == $aline) { # highlight line? - attron($wlog, COLOR_PAIR(1)); - $ret = $nr; # remember the NR - } - if ($screenlayout == 0) { - addstr($wlog,$y,0, sprintf("%-12s%-4s %-5s%-6s", - $call,$band,$mode,$date)); # print formatted - } - elsif ($screenlayout ==1) { - substr($time,-3,)=''; # remove seconds - addstr($wlog,$y,0, - sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", - $call,$band,$mode,$time,$date,$name,$qth,$rsts,$rstr, - $qsls, $qslr, $qslrl)); - } - - attron($wlog, COLOR_PAIR(3)); - $y--; # move one row up - } - while ($y > -1) { # fill remaining lines - my $width=30; - if ($screenlayout==1) {$width=80;} - addstr($wlog,$y,0," "x$width); - $y--; - } - - refresh($wlog); - - return "i" unless ($totalcalls); # no QSOs! - - $ch = &getch2(); # get character from keyboard - - if ($ch eq KEY_DOWN) { # key down was pressed - if ($aline < ($nbr-1)) { # no scrolling needed - $aline++; - } - elsif ($offset != 0) { # scroll down, when possible (=offset) - # (when there is an offset, it means we have scrolled back, so we can - # safely scroll forth again) - $offset -= $nbr; # next $nr (16 or 8) - $aline = 0; # cursor to highest line - } - } - - if ($ch eq KEY_UP) { # key up was pressed - if (($aline > -1) && - ($callsthispage>($nbr-$aline))) { # no scrolling needed - $aline--; - } - elsif ($callsthispage > ($nbr-1)) { - $offset += $nbr; # earlier 16/8 - $aline = ($nbr-1); # cursor to lowest line - } - } - - if (($ch eq KEY_NPAGE) && ($offset != 0)) { # scroll down 16/8 QSOs - $aline = 0; # first line - $offset -= $nbr; # next 16/8 QSOs - flushinp(); # avoid excessive scrolling - } +do { # loop and get keyboard input - elsif (($ch eq KEY_PPAGE) && $callsthispage>7) {# scroll up 16/8 QSOs - $aline = ($nbr-1); # last line - $offset += $nbr; # prev 8/16 QSOs - flushinp(); # avoid excessive scrolling - } - - elsif ($ch eq KEY_F(1)) { # go to the MAIN MENU - $goon = 0; # do not go on! - $ret = "m"; # return value m = Menu - } - - elsif ($ch eq KEY_F(8)) { # back to inp-window without any action - $goon = 0; # do not go on! - $ret = "i"; # return value i = Input Window - } - - elsif ($ch eq KEY_F(10)) { # to QSO b4-window without any action - $goon = 0; - $ret = "q"; # return value q = QSO Window - } - - elsif ($ch =~ /\s/) { # we selected a QSO! - $goon=0; # get out of the do .. while loop - } - - elsif ($ch eq KEY_F(12)) { # QUIT - endwin; - exit; - } - -} while ($goon); # as long as goon is true, we loop -return $ret; -} # &choseqso ends here + # after every keystroke the database query is done again and the active + # line displayed in another color. unfortunately chgat() does not work on + # things that have already been sent to the display with refresh(), so only + # colouring one line while scrolling is not possible. since I was too lazy + # to save the 16/8 QSOs into some kind of array, I decided to do the query + # every time again. no performance problems even on my old K6-300. + + my $cq = $dbh->prepare("SELECT `NR`, `CALL`, `BAND`, `MODE`, `DATE`, + `T_ON`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLS`, `QSLR`, `QSLRL` FROM + log_$mycall ORDER BY $by LIMIT $offset, $nbr"); + $cq->execute(); + +# my $nrofrows = $cq->execute(); -############################################################################## -# &getqso Gets a number as parameter and returns the @qso array matching to -# the number from the database. Also updates the content of the Inputfields to -# the QSO. This works for fields 0..13 and is designed for the LOG INPUT mode. -# (There is also geteditqso for the Search/Edit mode). -############################################################################## +# if ($nrofrows eq "0E0") { return "i"; } # nothing, back to log input + + # temporary vars + my ($nr, $call, $band, $mode, $date, $time, $name, $qth, $rsts, + $rstr,$qsls,$qslr, $qslrl); + $cq->bind_columns(\$nr, \$call, \$band, \$mode, \$date,\$time, \$name, + \$qth,\$rsts,\$rstr,\$qsls,\$qslr, \$qslrl); + $y = ($nbr-1); + my $callsthispage=0; # calls displayed on this page + while ($cq->fetch()) { # while row available + $callsthispage++; + $totalcalls++; + # we put the date into DD-MM-YY format from YYYY-MM-DD + $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); + # cut Call, Name, QTH, RSTR, RSTS, Mode + $call = substr($call,0,12); + $name = substr($name,0,8); + $qth = substr($qth,0,13); + $rstr = substr($rstr,0,3); + $rsts = substr($rsts,0,3); + $mode = substr($mode,0,5); + + if ($y == $aline) { # highlight line? + attron($wlog, COLOR_PAIR(1)); + $ret = $nr; # remember the NR + } + if ($screenlayout == 0) { + addstr($wlog,$y,0, sprintf("%-12s%-4s %-5s%-6s", + $call,$band,$mode,$date)); # print formatted + } + elsif ($screenlayout ==1) { + substr($time,-3,)=''; # remove seconds + addstr($wlog,$y,0, + sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", + $call,$band,$mode,$time,$date,$name,$qth,$rsts,$rstr, + $qsls, $qslr, $qslrl)); + } + + attron($wlog, COLOR_PAIR(3)); + $y--; # move one row up + } + while ($y > -1) { # fill remaining lines + my $width=30; + if ($screenlayout==1) {$width=80;} + addstr($wlog,$y,0," "x$width); + $y--; + } -sub getqso { -my @qso; # QSO array + refresh($wlog); + + return "i" unless ($totalcalls); # no QSOs! + + $ch = &getch2(); # get character from keyboard + + if ($ch eq KEY_DOWN) { # key down was pressed + if ($aline < ($nbr-1)) { # no scrolling needed + $aline++; + } + elsif ($offset != 0) { # scroll down, when possible (=offset) + # (when there is an offset, it means we have scrolled back, so we can + # safely scroll forth again) + $offset -= $nbr; # next $nr (16 or 8) + $aline = 0; # cursor to highest line + } + } + + if ($ch eq KEY_UP) { # key up was pressed + if (($aline > -1) && + ($callsthispage>($nbr-$aline))) { # no scrolling needed + $aline--; + } + elsif ($callsthispage > ($nbr-1)) { + $offset += $nbr; # earlier 16/8 + $aline = ($nbr-1); # cursor to lowest line + } + } + + if (($ch eq KEY_NPAGE) && ($offset != 0)) { # scroll down 16/8 QSOs + $aline = 0; # first line + $offset -= $nbr; # next 16/8 QSOs + flushinp(); # avoid excessive scrolling + } + + elsif (($ch eq KEY_PPAGE) && $callsthispage>7) {# scroll up 16/8 QSOs + $aline = ($nbr-1); # last line + $offset += $nbr; # prev 8/16 QSOs + flushinp(); # avoid excessive scrolling + } + + elsif ($ch eq KEY_F(1)) { # go to the MAIN MENU + $goon = 0; # do not go on! + $ret = "m"; # return value m = Menu + } + + elsif ($ch eq KEY_F(8)) { # back to inp-window without any action + $goon = 0; # do not go on! + $ret = "i"; # return value i = Input Window + } + + elsif ($ch eq KEY_F(10)) { # to QSO b4-window without any action + $goon = 0; + $ret = "q"; # return value q = QSO Window + } + + elsif ($ch =~ /\s/) { # we selected a QSO! + $goon=0; # get out of the do .. while loop + } + + elsif ($ch eq KEY_F(12)) { # QUIT + endwin; + exit; + } + +} while ($goon); # as long as goon is true, we loop +return $ret; +} # &choseqso ends here + +############################################################################## +# &getqso Gets a number as parameter and returns the @qso array matching to +# the number from the database. Also updates the content of the Inputfields to +# the QSO. This works for fields 0..13 and is designed for the LOG INPUT mode. +# (There is also geteditqso for the Search/Edit mode). +############################################################################## + +sub getqso { +my @qso; # QSO array my $q = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, `MODE`, - `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR` FROM - log_$mycall WHERE `NR`='$_[0]'"); + `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR` FROM + log_$mycall WHERE `NR`='$_[0]'"); $q->execute; @qso = $q->fetchrow_array; # proper format for the date (yyyy-mm-dd -> ddmmyyyy) @@ -1905,9 +1905,9 @@ $qso[1] = substr($qso[1],8,2).substr($qso[1],5,2).substr($qso[1],0,4); $qso[2] = substr($qso[2],0,2).substr($qso[2],3,2); $qso[3] = substr($qso[3],0,2).substr($qso[3],3,2); -for (my $x=0;$x < 14;$x++) { # iterate through all input windows - addstr(${$_[1]}[$x],0,0,$qso[$x]); # add new value from @qso. - refresh(${$_[1]}[$x]); +for (my $x=0;$x < 14;$x++) { # iterate through all input windows + addstr(${$_[1]}[$x],0,0,$qso[$x]); # add new value from @qso. + refresh(${$_[1]}[$x]); } return @qso; @@ -1919,171 +1919,171 @@ return @qso; ############################################################################## sub chosepqso { - my $wqsos = ${$_[0]}; # reference to $wqsos window - my $call = $_[1]; # callsign of the current entry - my $offset=0; # offset from first 16 - my $ch; # character we get from keyboard - my $ret=0; # return value - my $goon=1; # "go on" in the do .. while loop - my $aline=0; # activeline - my $pos=1; # the position of the active line, not - # on the screen but in total from - # 1 .. $count. we start at 1. - my $nbr; # nr of lines/qsos - my $totalcalls=0; # if 0, return i. - - my $ascdesc = ' ASC '; - - if ($prevsort eq 'D') { - $ascdesc = ' DESC '; - } - - - - # set number of QSOs to display at once. - if ($screenlayout == 0) { - $nbr = 16; - } - elsif ($screenlayout == 1) { - $nbr = ($main::row-8)/2; - } - - # Get the homecall from a call with /, split and take longest part: - # PA/DJ1YFK/P --> DJ1YFK etc. - my @call = split(/\//, $call); - my $length=0; # length of splitted part - foreach(@call) { # chose longest part as homecall - if (length($_) >= $length) { - $length = length($_); - $call = $_; - } - } - - # First we want to know how many QSOs there are... - my $lq = $dbh->prepare("SELECT count(*) from log_$mycall WHERE - `CALL` = '$call' OR - `CALL` LIKE '\%/$call' OR - `CALL` LIKE '\%/$call/\%' OR - `CALL` LIKE '$call/\%'"); - - - $lq->execute(); # number of prev. QSOs in $count - my $count = $lq->fetchrow_array(); - - return 'i' unless ($count); - - -do { # we start looping here - my $lq = $dbh->prepare("SELECT `NR`, `CALL`, `DATE`, `T_ON`, `BAND`, `MODE`, - `QSLS`, `QSLR`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLRL` FROM - log_$mycall WHERE `CALL` = '$call' OR - `CALL` LIKE '\%/$call' OR - `CALL` LIKE '\%/$call/\%' OR - `CALL` LIKE '$call/\%' - ORDER BY `DATE` $ascdesc, `T_ON` $ascdesc - LIMIT $offset, $nbr"); - - $lq->execute(); - - my ($nr, $fcall, $date, $time, $band, $mode, $qsls, $qslr, $name, $qth, - $rsts, $rstr, $qslrl); # temp vars - - $lq->bind_columns(\$nr,\$fcall,\$date,\$time,\$band,\$mode,\$qsls,\$qslr, - \$name, \$qth, \$rsts, \$rstr, \$qslrl); - - my $y = 0; - while ($lq->fetch()) { # more QSOs available - $totalcalls++; - $time = substr($time, 0,5); # cut seconds from time - $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); - # cut Call, Name, QTH, RSTR, RSTS, Mode - $fcall = substr($fcall,0,12); - $name = substr($name,0,8); - $qth = substr($qth,0,13); - $rstr = substr($rstr,0,3); - $rsts = substr($rsts,0,3); - $mode = substr($mode,0,5); - - my $line; - if ($screenlayout == 0) { - $line = sprintf("%-14s %-8s %-5s %4s %-4s %1s %1s ", - $fcall, $date, $time, $band, $mode, $qsls, $qslr); - } - elsif ($screenlayout ==1) { - $line = sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", - $fcall,$band,$mode,$time,$date,$name,$qth,$rsts, - $rstr, $qsls, $qslr, $qslrl); - } - - if ($y == $aline) { # highlight line? - attron($wqsos, COLOR_PAIR(1)); # highlight - $ret = $nr; # remember NR - } - addstr($wqsos, $y, 0, $line); - attron($wqsos, COLOR_PAIR(4)); - ($y < $nbr) ? $y++ : last; # prints first 8/16 rows - } # all QSOs printed - - for (;$y < $nbr;$y++) { # for the remaining rows - addstr($wqsos, $y, 0, " "x80); # fill with whitespace - } - refresh($wqsos); - - $ch = &getch2(); # get keyboard input - - if ($ch eq KEY_DOWN) { # arrow key down - # we now have to check two things: 1. is the $pos lower than $count? - # 2. are we at the end of a page and have to scroll? - if ($pos < $count) { # we can go down, but on same page? - if ($aline < ($nbr-1)) { - $aline++; - $pos++; - } - else { # we have to scroll! - $offset += $nbr; # add offset -> next 8/16 QSOs - $aline=0; # go to first line - $pos++; # we go one pos further - } - } - } - - elsif ($ch eq KEY_UP) { # arrow key up - # we now have to check two things: 1. is the $pos over 1 (=lowest)? - # 2. are we at the start of a page (aline=0) and have to scroll back? - if ($pos > 1) { # we can go up, but on same page? - if ($aline > 0) { # we stay on same page - $aline--; - $pos--; - } - else { # scroll up! - $offset -= $nbr; # decrease offset - $aline=($nbr-1); # start on lowest line of new page - $pos--; # go back one position - } - } - } - - elsif ($ch eq KEY_F(1)) { # go to MAIN MENU - return "m"; - } - - elsif ($ch eq KEY_F(8)) { # back to input window - return "i"; - } - - elsif ($ch eq KEY_F(9)) { # back to input window - return "l"; - } - - elsif ($ch eq KEY_F(12)) { # QUIT YFKlog - endwin; - exit; - } - elsif ($ch =~ /\s/) { # finished! - return $ret; # return value was prepared earlier - } - -} while ($goon); # loop until $goon is false + my $wqsos = ${$_[0]}; # reference to $wqsos window + my $call = $_[1]; # callsign of the current entry + my $offset=0; # offset from first 16 + my $ch; # character we get from keyboard + my $ret=0; # return value + my $goon=1; # "go on" in the do .. while loop + my $aline=0; # activeline + my $pos=1; # the position of the active line, not + # on the screen but in total from + # 1 .. $count. we start at 1. + my $nbr; # nr of lines/qsos + my $totalcalls=0; # if 0, return i. + + my $ascdesc = ' ASC '; + + if ($prevsort eq 'D') { + $ascdesc = ' DESC '; + } + + + + # set number of QSOs to display at once. + if ($screenlayout == 0) { + $nbr = 16; + } + elsif ($screenlayout == 1) { + $nbr = ($main::row-8)/2; + } + + # Get the homecall from a call with /, split and take longest part: + # PA/DJ1YFK/P --> DJ1YFK etc. + my @call = split(/\//, $call); + my $length=0; # length of splitted part + foreach(@call) { # chose longest part as homecall + if (length($_) >= $length) { + $length = length($_); + $call = $_; + } + } + + # First we want to know how many QSOs there are... + my $lq = $dbh->prepare("SELECT count(*) from log_$mycall WHERE + `CALL` = '$call' OR + `CALL` LIKE '\%/$call' OR + `CALL` LIKE '\%/$call/\%' OR + `CALL` LIKE '$call/\%'"); + + + $lq->execute(); # number of prev. QSOs in $count + my $count = $lq->fetchrow_array(); + + return 'i' unless ($count); + + +do { # we start looping here + my $lq = $dbh->prepare("SELECT `NR`, `CALL`, `DATE`, `T_ON`, `BAND`, `MODE`, + `QSLS`, `QSLR`, `NAME`, `QTH`, `RSTS`, `RSTR`, `QSLRL` FROM + log_$mycall WHERE `CALL` = '$call' OR + `CALL` LIKE '\%/$call' OR + `CALL` LIKE '\%/$call/\%' OR + `CALL` LIKE '$call/\%' + ORDER BY `DATE` $ascdesc, `T_ON` $ascdesc + LIMIT $offset, $nbr"); + + $lq->execute(); + + my ($nr, $fcall, $date, $time, $band, $mode, $qsls, $qslr, $name, $qth, + $rsts, $rstr, $qslrl); # temp vars + + $lq->bind_columns(\$nr,\$fcall,\$date,\$time,\$band,\$mode,\$qsls,\$qslr, + \$name, \$qth, \$rsts, \$rstr, \$qslrl); + + my $y = 0; + while ($lq->fetch()) { # more QSOs available + $totalcalls++; + $time = substr($time, 0,5); # cut seconds from time + $date = substr($date,8,2).substr($date,4,4).substr($date,2,2); + # cut Call, Name, QTH, RSTR, RSTS, Mode + $fcall = substr($fcall,0,12); + $name = substr($name,0,8); + $qth = substr($qth,0,13); + $rstr = substr($rstr,0,3); + $rsts = substr($rsts,0,3); + $mode = substr($mode,0,5); + + my $line; + if ($screenlayout == 0) { + $line = sprintf("%-14s %-8s %-5s %4s %-4s %1s %1s ", + $fcall, $date, $time, $band, $mode, $qsls, $qslr); + } + elsif ($screenlayout ==1) { + $line = sprintf("%-12s%-4s %-5s%-4s %-6s %-8s %-13s %-3s %-3s %s %s %s ", + $fcall,$band,$mode,$time,$date,$name,$qth,$rsts, + $rstr, $qsls, $qslr, $qslrl); + } + + if ($y == $aline) { # highlight line? + attron($wqsos, COLOR_PAIR(1)); # highlight + $ret = $nr; # remember NR + } + addstr($wqsos, $y, 0, $line); + attron($wqsos, COLOR_PAIR(4)); + ($y < $nbr) ? $y++ : last; # prints first 8/16 rows + } # all QSOs printed + + for (;$y < $nbr;$y++) { # for the remaining rows + addstr($wqsos, $y, 0, " "x80); # fill with whitespace + } + refresh($wqsos); + + $ch = &getch2(); # get keyboard input + + if ($ch eq KEY_DOWN) { # arrow key down + # we now have to check two things: 1. is the $pos lower than $count? + # 2. are we at the end of a page and have to scroll? + if ($pos < $count) { # we can go down, but on same page? + if ($aline < ($nbr-1)) { + $aline++; + $pos++; + } + else { # we have to scroll! + $offset += $nbr; # add offset -> next 8/16 QSOs + $aline=0; # go to first line + $pos++; # we go one pos further + } + } + } + + elsif ($ch eq KEY_UP) { # arrow key up + # we now have to check two things: 1. is the $pos over 1 (=lowest)? + # 2. are we at the start of a page (aline=0) and have to scroll back? + if ($pos > 1) { # we can go up, but on same page? + if ($aline > 0) { # we stay on same page + $aline--; + $pos--; + } + else { # scroll up! + $offset -= $nbr; # decrease offset + $aline=($nbr-1); # start on lowest line of new page + $pos--; # go back one position + } + } + } + + elsif ($ch eq KEY_F(1)) { # go to MAIN MENU + return "m"; + } + + elsif ($ch eq KEY_F(8)) { # back to input window + return "i"; + } + + elsif ($ch eq KEY_F(9)) { # back to input window + return "l"; + } + + elsif ($ch eq KEY_F(12)) { # QUIT YFKlog + endwin; + exit; + } + elsif ($ch =~ /\s/) { # finished! + return $ret; # return value was prepared earlier + } + +} while ($goon); # loop until $goon is false } @@ -2102,13 +2102,13 @@ elsif ($_[0] == 1) { return "QTH: Name: QSLs: QSLr: RSTs: RSTr: "; } elsif ($_[0] == 2) { - return "Remarks: PWR: W "; + return "Remarks: PWR: W "; } elsif ($_[0] == 3) { - return "DXCC: PFX: CONT: ITUZ: CQ: QSLINFO:"; + return "DXCC: PFX: CONT: ITUZ: CQ: QSLINFO:"; } else { - return "IOTA: STATE: QSLrL: OP: GRID: QSO Nr: " + return "IOTA: STATE: QSLrL: OP: GRID: QSO Nr: " } } @@ -2126,10 +2126,10 @@ return "F2: Save Q F3: Clear Q F8: Input Window F9: Log window F10: Prev. QS sub winfomask { if ($_[0] == 0) { - return "Country: DXCC: WPX: ITU: CQZ: "; + return "Country: DXCC: WPX: ITU: CQZ: "; } else { - return "Lat: Long: Distance: Direction: "; + return "Lat: Long: Distance: Direction: "; } } @@ -2146,117 +2146,117 @@ else { sub selectlist { -my $ch; # keyboard input -my $win = ${$_[0]}; # Window to work in -my $ystart = $_[1]; # y start position -my $xstart = $_[2]; # x start position -my $height = $_[3]; # height of the list -my $width = $_[4]; # width of the items -my @items = @{$_[5]}; # list items -my $item; # a single item -my $y=0; # y position in the window -my $yoffset=0; # y offset, in case we scrolled -my $aline=0; # active line (absolute position in @items) +my $ch; # keyboard input +my $win = ${$_[0]}; # Window to work in +my $ystart = $_[1]; # y start position +my $xstart = $_[2]; # x start position +my $height = $_[3]; # height of the list +my $width = $_[4]; # width of the items +my @items = @{$_[5]}; # list items +my $item; # a single item +my $y=0; # y position in the window +my $yoffset=0; # y offset, in case we scrolled +my $aline=0; # active line (absolute position in @items) # Possibly the number of menu items is lower than the specified height. If this # is the case, the height is lowered to the number of menu items. # (On the other hand, if there were more items than height, we have to scroll!) -if ($height > @items) { # Not enough items to fill the specified height - $height = @items; # adjust height +if ($height > @items) { # Not enough items to fill the specified height + $height = @items; # adjust height } # To make the highlighted line look better, we extend all items to the maximum # length with whitespaces. Of course too long ones will be cut. -for (my $i=0; $i < @items; $i++) { # iterate through items - my $l = length($items[$i]); # length of item - if ($l < $width) { # too short - $items[$i] .= " " x ($width - $l); # add spaces - } - else { # same length or longer - $items[$i] = substr($items[$i], 0, $width); # cut if needed - } +for (my $i=0; $i < @items; $i++) { # iterate through items + my $l = length($items[$i]); # length of item + if ($l < $width) { # too short + $items[$i] .= " " x ($width - $l); # add spaces + } + else { # same length or longer + $items[$i] = substr($items[$i], 0, $width); # cut if needed + } } do { -for ($y=$ystart; $y < ($ystart+$height); $y++) { # go through $y range - if (($y+$yoffset-$ystart) == $aline) { # active line - attron($win, COLOR_PAIR(1)); # highlight it - } - if (defined($items[$y-$ystart+$yoffset])) { # if line exists - addstr($win, $y, $xstart, $items[$y-$ystart+$yoffset]); # print - } - else { # if not - addstr($win, $y, $xstart, " " x $width); # fill with spaces - } - attron($win, COLOR_PAIR(2)); # normal colors again +for ($y=$ystart; $y < ($ystart+$height); $y++) { # go through $y range + if (($y+$yoffset-$ystart) == $aline) { # active line + attron($win, COLOR_PAIR(1)); # highlight it + } + if (defined($items[$y-$ystart+$yoffset])) { # if line exists + addstr($win, $y, $xstart, $items[$y-$ystart+$yoffset]); # print + } + else { # if not + addstr($win, $y, $xstart, " " x $width); # fill with spaces + } + attron($win, COLOR_PAIR(2)); # normal colors again }# end of for(); - + refresh($win); $ch = getch(); -if ($ch eq KEY_DOWN) { # Arrow down was pressed - if ($aline < $#items) { # not at last position - # We can savely increase $aline, because we are not yet at the end of the - # items array. - $aline++; - # now it is possible that we have to scroll. this is the case when - if ($y+$yoffset-$ystart == $aline) { - $yoffset += $height; - } - } - elsif ($aline == $#items) { # at last position - # We wrap to first line and scroll up. - $aline = 0; - $yoffset = 0; - } +if ($ch eq KEY_DOWN) { # Arrow down was pressed + if ($aline < $#items) { # not at last position + # We can savely increase $aline, because we are not yet at the end of the + # items array. + $aline++; + # now it is possible that we have to scroll. this is the case when + if ($y+$yoffset-$ystart == $aline) { + $yoffset += $height; + } + } + elsif ($aline == $#items) { # at last position + # We wrap to first line and scroll up. + $aline = 0; + $yoffset = 0; + } } -elsif ($ch eq KEY_UP) { # arrow up - if ($aline > 0) { # we are not at 0 - # We can savely decrease the $aline position, but maybe we have to scroll - # up - $aline--; - # We have to scroll up if the active line is smaller than the offset.. - if ($yoffset > $aline) { - $yoffset -= $height; - } - } - elsif ($aline == 0) { # we are at 0 - # We wrap to the last line and scroll down - $aline = $#items; - # To find the offset we divide number of items by height, - # so just the remainder of the division is showed. - # Number of items is decreased by 1, because offset starts at 0. - $yoffset = int((@items - 1)/$height)*$height; - } +elsif ($ch eq KEY_UP) { # arrow up + if ($aline > 0) { # we are not at 0 + # We can savely decrease the $aline position, but maybe we have to scroll + # up + $aline--; + # We have to scroll up if the active line is smaller than the offset.. + if ($yoffset > $aline) { + $yoffset -= $height; + } + } + elsif ($aline == 0) { # we are at 0 + # We wrap to the last line and scroll down + $aline = $#items; + # To find the offset we divide number of items by height, + # so just the remainder of the division is showed. + # Number of items is decreased by 1, because offset starts at 0. + $yoffset = int((@items - 1)/$height)*$height; + } } -elsif ($ch eq KEY_HOME) { # Pos1 key - # Go to first line and remove offset - # same as wrapping to first line - $aline = 0; - $yoffset = 0; +elsif ($ch eq KEY_HOME) { # Pos1 key + # Go to first line and remove offset + # same as wrapping to first line + $aline = 0; + $yoffset = 0; } -elsif ($ch eq KEY_END) { # End key - # Go to last line and set offset - # same as wrapping to last line - $aline = $#items; - $yoffset = int((@items - 1)/$height)*$height; +elsif ($ch eq KEY_END) { # End key + # Go to last line and set offset + # same as wrapping to last line + $aline = $#items; + $yoffset = int((@items - 1)/$height)*$height; } -elsif ($ch eq KEY_F(1)) { # F1 - Back to main menu - return "m"; +elsif ($ch eq KEY_F(1)) { # F1 - Back to main menu + return "m"; } -elsif ($ch eq KEY_F(12)) { # F12 - QUIT YFKlog - endwin(); - exit; +elsif ($ch eq KEY_F(12)) { # F12 - QUIT YFKlog + endwin(); + exit; } elsif (ord($ch) eq '27') { - $ch = getch(); - if ($ch eq '1') { - return "m"; - } + $ch = getch(); + if ($ch eq '1') { + return "m"; + } } } until ($ch =~ /\s/); @@ -2269,103 +2269,103 @@ return $aline; ############################################################################## sub askbox { - # We get the parameters ... - my ($ypos, $xpos, $height, $width, $valid, $text, $str) = @_; - my $win; # The window in which we are working - my $iwin; # The Input window - my $ch=""; # we store the keyboard input here - - my $pos=0; # position of the cursor in the string - - $win = &makewindow($height, $width, $ypos, $xpos, 7); # create askbox - $iwin = &makewindow(1, $width-4, $ypos + 2, $xpos + 2, 5); # input window - - addstr($win, 0, ($width-length($text))/2, $text); # put question - addstr($iwin,0,0, " " x $width); # clear inputw - move($iwin, 0,0); # cursor to 0,0 - refresh($win); # refresh ... - refresh($iwin); - - if ($valid eq 'filename') { - $valid = '[_A-Za-z.0-9\/]'; - } - elsif ($valid eq 'text') { - $valid = '[_A-Za-z.0-9\/ ]'; - } - - # Now we start reading from the keyboard, character by character - # This is mostly identical to &readw; - - curs_set(1); - - while (1) { # loop until beer is empty - addstr($iwin, 0,0, $str." "x80); # put $str in inputwindow - move ($iwin,0,$pos); # move cursor to $pos - refresh($iwin); # show new window - $ch = &getch2(); # get character from keyboard - - # We first check if it is a legal character of the specified $match, - # if so, it will be added to the string (at the proper position!) - if ($ch =~ /^$valid$/) { # check if it's "legal" - unless(($valid eq '\w') || ($valid eq '[_A-Za-z.0-9\/]') - || ($valid eq '[_A-Za-z.0-9\/ ]')) { - $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase - } - - # Add at proper position.. - $pos++; - $str = substr($str, 0, $pos-1).$ch.substr($str, $pos-1, ); - } - - # The l/r arrow keys change the position of the cursor to left or right - # but only within the boundaries of $str. - - elsif ($ch eq KEY_LEFT) { # arrow left was pressed - if ($pos > 0) { $pos-- } # go left if possible - } - - elsif ($ch eq KEY_RIGHT) { # arrow right was pressed - if ($pos < length($str)) { $pos++ } # go right if possible - } - - elsif ($ch eq KEY_HOME) { # Pos1 key was pressed, go to first char - $pos = 0; - } - - elsif ($ch eq KEY_END) { # End key was pressed, go behind last char - $pos = length($str); - } - - elsif (($ch eq KEY_DC) && ($pos < length($str))) { # Delete key - $str = substr($str, 0, $pos).substr($str, $pos+1, ); - } - - elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) - && ($pos > 0)) { - $str = substr($str, 0, $pos-1).substr($str, $pos, ); - $pos--; - } - - elsif ($ch =~ /\s/) { # finished entering - delwin($win); - delwin($iwin); - return $str; - } - - # Back to main Menu by F1.... - elsif ($ch eq KEY_F(1)) { # MAIN MENU - delwin($win); - delwin($iwin); - return "m"; - } - - # Back to main Menu by F1.... - elsif ($ch eq KEY_F(12)) { # Quit - endwin(); - exit; - } - - } # end of infinite while loop + # We get the parameters ... + my ($ypos, $xpos, $height, $width, $valid, $text, $str) = @_; + my $win; # The window in which we are working + my $iwin; # The Input window + my $ch=""; # we store the keyboard input here + + my $pos=0; # position of the cursor in the string + + $win = &makewindow($height, $width, $ypos, $xpos, 7); # create askbox + $iwin = &makewindow(1, $width-4, $ypos + 2, $xpos + 2, 5); # input window + + addstr($win, 0, ($width-length($text))/2, $text); # put question + addstr($iwin,0,0, " " x $width); # clear inputw + move($iwin, 0,0); # cursor to 0,0 + refresh($win); # refresh ... + refresh($iwin); + + if ($valid eq 'filename') { + $valid = '[_A-Za-z.0-9\/]'; + } + elsif ($valid eq 'text') { + $valid = '[_A-Za-z.0-9\/ ]'; + } + + # Now we start reading from the keyboard, character by character + # This is mostly identical to &readw; + + curs_set(1); + + while (1) { # loop until beer is empty + addstr($iwin, 0,0, $str." "x80); # put $str in inputwindow + move ($iwin,0,$pos); # move cursor to $pos + refresh($iwin); # show new window + $ch = &getch2(); # get character from keyboard + + # We first check if it is a legal character of the specified $match, + # if so, it will be added to the string (at the proper position!) + if ($ch =~ /^$valid$/) { # check if it's "legal" + unless(($valid eq '\w') || ($valid eq '[_A-Za-z.0-9\/]') + || ($valid eq '[_A-Za-z.0-9\/ ]')) { + $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase + } + + # Add at proper position.. + $pos++; + $str = substr($str, 0, $pos-1).$ch.substr($str, $pos-1, ); + } + + # The l/r arrow keys change the position of the cursor to left or right + # but only within the boundaries of $str. + + elsif ($ch eq KEY_LEFT) { # arrow left was pressed + if ($pos > 0) { $pos-- } # go left if possible + } + + elsif ($ch eq KEY_RIGHT) { # arrow right was pressed + if ($pos < length($str)) { $pos++ } # go right if possible + } + + elsif ($ch eq KEY_HOME) { # Pos1 key was pressed, go to first char + $pos = 0; + } + + elsif ($ch eq KEY_END) { # End key was pressed, go behind last char + $pos = length($str); + } + + elsif (($ch eq KEY_DC) && ($pos < length($str))) { # Delete key + $str = substr($str, 0, $pos).substr($str, $pos+1, ); + } + + elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) + && ($pos > 0)) { + $str = substr($str, 0, $pos-1).substr($str, $pos, ); + $pos--; + } + + elsif ($ch =~ /\s/) { # finished entering + delwin($win); + delwin($iwin); + return $str; + } + + # Back to main Menu by F1.... + elsif ($ch eq KEY_F(1)) { # MAIN MENU + delwin($win); + delwin($iwin); + return "m"; + } + + # Back to main Menu by F1.... + elsif ($ch eq KEY_F(12)) { # Quit + endwin(); + exit; + } + + } # end of infinite while loop } @@ -2388,334 +2388,334 @@ sub askbox { sub toggleqsl { - curs_set(0); # no cursor please - my $win = ${$_[0]}; # reference to $wmain window - my $call = $_[1]; # callsign to display - my $details = $_[2]; # show details of QSO? - my $write="0"; # nonzero, when we are in writing mode - my $count; # number of available lines from DB - my $goon=1; # we want to go on... - my $offset=0; # offset when scrolling the list - my $aline=0; # first line is active (highlighted) - my $ch=""; # char we read from keyboard - my $chnr=0; # number (NR) of active line - my $qslstat; # QSL status (QSLR or S) of active line - my $qslstat2; # same, for QSL-R mode to toggle QSL-S too - my %changes; # saves the changes we have made to QSL-R (in - # receive mode) or QSL-S in write mode - # (NR => old value) - my %changes2; # same for QSL-S status in QSL-receive mode - - my ($yh, $xw); + curs_set(0); # no cursor please + my $win = ${$_[0]}; # reference to $wmain window + my $call = $_[1]; # callsign to display + my $details = $_[2]; # show details of QSO? + my $write="0"; # nonzero, when we are in writing mode + my $count; # number of available lines from DB + my $goon=1; # we want to go on... + my $offset=0; # offset when scrolling the list + my $aline=0; # first line is active (highlighted) + my $ch=""; # char we read from keyboard + my $chnr=0; # number (NR) of active line + my $qslstat; # QSL status (QSLR or S) of active line + my $qslstat2; # same, for QSL-R mode to toggle QSL-S too + my %changes; # saves the changes we have made to QSL-R (in + # receive mode) or QSL-S in write mode + # (NR => old value) + my %changes2; # same for QSL-S status in QSL-receive mode + + my ($yh, $xw); my $row = $main::row; # First check if we are in QSL receive or write mode. When write mode, set # $write to 1 if ($call eq "W") { - $write = "1"; - ($yh, $xw) = (($row-2) - ($details * 5), 80); # x,y width of the window + $write = "1"; + ($yh, $xw) = (($row-2) - ($details * 5), 80); # x,y width of the window } -else { # receive - ($yh, $xw) = (($row-2), 80); - $details = 0; +else { # receive + ($yh, $xw) = (($row-2), 80); + $details = 0; } -if ($write) { # QSL Write mode - # Check if there are any QSLs in the queue... - my $c = $dbh->prepare("SELECT count(*) from log_$mycall WHERE QSLS='Q'"); - $c->execute(); # number of queued QSLs in $count +if ($write) { # QSL Write mode + # Check if there are any QSLs in the queue... + my $c = $dbh->prepare("SELECT count(*) from log_$mycall WHERE QSLS='Q'"); + $c->execute(); # number of queued QSLs in $count - $count = $c->fetchrow_array(); + $count = $c->fetchrow_array(); - # When 0 lines are returned, there is no QSL in the queue - # we pop out a message and quit. + # When 0 lines are returned, there is no QSL in the queue + # we pop out a message and quit. - if ($count == 0) { - addstr($win, 0,0, " " x ($xw * $yh)); # clear window - addstr($win, 9, 33, "No QSL queued!"); - refresh($win); - getch(); # wait for user - return 2; # return to main menu - } + if ($count == 0) { + addstr($win, 0,0, " " x ($xw * $yh)); # clear window + addstr($win, 9, 33, "No QSL queued!"); + refresh($win); + getch(); # wait for user + return 2; # return to main menu + } } -else { # QSL receive mode - # check if there are any QSOs that match with the string - # we entered... - my $c = $dbh->prepare("SELECT count(*) from log_$mycall WHERE - `CALL` LIKE '\%$call\%';"); - - $c->execute() or die "Can't count nr of queued QSLs!"; - - $count = $c->fetchrow_array(); - - # When 0 lines are returned, there is no QSO to chose - # we pop out a message and quit. - - if ($count == 0) { - addstr($win, 0,0, " " x ($xw * $yh)); # clear window - my $msg = "No QSO found matching $call!"; - addstr($win, 9, ($xw-length($msg))/2 , $msg); - refresh($win); - getch(); # wait for user - return 3; - } +else { # QSL receive mode + # check if there are any QSOs that match with the string + # we entered... + my $c = $dbh->prepare("SELECT count(*) from log_$mycall WHERE + `CALL` LIKE '\%$call\%';"); + + $c->execute() or die "Can't count nr of queued QSLs!"; + + $count = $c->fetchrow_array(); + + # When 0 lines are returned, there is no QSO to chose + # we pop out a message and quit. + + if ($count == 0) { + addstr($win, 0,0, " " x ($xw * $yh)); # clear window + my $msg = "No QSO found matching $call!"; + addstr($win, 9, ($xw-length($msg))/2 , $msg); + refresh($win); + getch(); # wait for user + return 3; + } } # We have at least one QSO to display if arrived here.... - -do { # we start looping here - - # We query the database again, this time we select all the stuff we want to - # display. When we are in QSL write mode, select where QSLS = Q, else - # select by CALL. - # In the QSL receive mode it will be sorted by date, in QSL write mode by - # callsign, then date. - - my $lq; - - if ($write) { - $lq = $dbh->prepare("SELECT - `NR`, `CALL`, `NAME`, `QSLINFO`, `DATE`, - `T_ON`, `BAND`, `MODE`, `QSLS`, `QSLR`, `PWR`, `QTH`, `RSTS`, - `RSTR`, `REM`, `DXCC`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID` - FROM log_$mycall - WHERE `QSLS`='Q' OR `QSLS`='X' ORDER BY `CALL`, `DATE`, `T_ON` - LIMIT $offset, $yh"); - } - else { - $lq = $dbh->prepare("SELECT - `NR`, `CALL`, `NAME`, `QSLINFO`, `DATE`, - `T_ON`, `BAND`, `MODE`, `QSLS`, `QSLR`, `PWR`, `QTH`, `RSTS`, - `RSTR`, `REM`, `DXCC`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID` - FROM log_$mycall - WHERE `CALL` LIKE - '\%$call\%' ORDER BY `DATE`, `T_ON` LIMIT $offset, $yh"); - - } - - $lq->execute() or die "Couldn't select log entries!"; # Execute the prepared Query - - # Temporary variables for every retrieved QSO ... - my ($nr, $fcall, $name, $qsli, $date, $time, $band, $mode, $qsls, $qslr, - $pwr, $qth, $rsts, $rstr, $rem, $dxcc, $iota, $state, $qslrl, $op, - $grid); - - $lq->bind_columns(\$nr,\$fcall,\$name,\$qsli,\$date,\$time,\$band, - \$mode,\$qsls,\$qslr,\$pwr,\$qth, \$rsts, \$rstr, - \$rem, \$dxcc, \$iota, \$state, \$qslrl, \$op, \$grid); - - my $y = 0; # y-position in $win - while ($lq->fetch()) { # more QSOs available - $time = substr($time, 0,5); # cut seconds from time - if ($qsls eq "X") { $qsls = "Y" } # see below - my $line=sprintf("%-6s %-12s %-11s%-9s%-8s %-5s %4s %4s %-4s %1s %1s ", - $nr, $fcall, $name, $qsli, $date, $time, $pwr, $band, $mode, $qsls, $qslr); - if ($qsls eq "Y") { $qsls = "X" } - if ($y == $aline) { # highlight line? - $chnr = $nr; # save number of aline - # save QSL status, depending on read/write mode. When in receive - # mode, also save qsl-sent status to toggle it when replying to - # incoming cards. - if ($write) { $qslstat = $qsls } - else { - $qslstat = $qslr; - $qslstat2 = $qsls; - } - addstr($win, $yh+1, 0, - sprintf("Additional QSO details: %6s - %-15s", $nr, $fcall)); - addstr($win, $yh+2, 0, - sprintf("RSTs: %-5s RSTr: %-5s QTH: %-18s DXCC: %4s IOTA: %-7s" - , $rsts, $rstr, $qth, $dxcc, $iota)); - addstr($win, $yh+3, 0, - sprintf("Power: %-4sW OP: %8s GRID: %-17s LOTW: %s", - $pwr, $op, $grid, $qslrl)); - addstr($win, $yh+4, 0, sprintf("Rem: %-60s", $rem)); - attron($win, COLOR_PAIR(3)); # highlight - } - addstr($win, $y, 0, $line); - attron($win, COLOR_PAIR(4)); - ($y < $yh) ? $y++ : last; # prints first $yh (22) rows - } # all QSOs printed - - for (;$y < $yh;$y++) { # for the remaining rows - addstr($win, $y, 0, " "x80); # fill with whitespace - } - - refresh($win); - - $ch = &getch2(); - - # Now start to analyse the input... - - # When Space is pressed, it means we toggle the QSL status of the current - # active QSO, NR saved in $chnr. In case that the user decides NOT to save - # the changes, we remember all changes that we made in the hash %changes, - # so they can be restored later. - # This is neccessary, because the DB is queried every time the cursor - # moves, so we cannot make changes in a temporary qso-array or so... - - if ($ch eq " ") { # SPACE BAR -> toggle QSL status - unless (defined $changes{$chnr}) { # we have NOT saved the original - $changes{$chnr} = $qslstat; # save it - } - - # We want to let the user *toggle* the status, so the change we make - # depends on the current value. - - if ($write) { # QSL write mode Q->Y - # "X" is used instead of "Y" as status, because if it's "Y", the - # QSO will not appear anymore in the list, when we update the - # screen... - - if ($qslstat eq "Q") { $qslstat = "X" } - elsif ($qslstat eq "X") { $qslstat = "Q"} - # Update database record... - $dbh->do("UPDATE log_$mycall SET QSLS='$qslstat' - WHERE NR='$chnr';"); - } - else { # QSL receive mode N->Y - if ($qslstat eq "N") { $qslstat = "Y" } - elsif ($qslstat eq "Y") { $qslstat = "N" } - $dbh->do("UPDATE log_$mycall SET QSLR='$qslstat' - WHERE NR='$chnr';"); - } - } # end of Spacebar handling - - # When pressing "s" in QSL-receive mode, toggle the QSl-sent flag. This is - # thought to be used for replying to incoming QSLs where no card has been - # sent. Toggling goes N->Y->Q - - elsif (($ch eq "s") && (not $write)) { - unless (defined $changes2{$chnr}) { # we have NOT saved the original - $changes2{$chnr} = $qslstat2; # save it - } - - if ($qslstat2 eq "N") { $qslstat2 = "X" } - elsif ($qslstat2 eq "X") { $qslstat2 = "Q" } - elsif ($qslstat2 eq "Q") { $qslstat2 = "N" } - $dbh->do("UPDATE log_$mycall SET QSLS='$qslstat2' - WHERE NR='$chnr';"); - } - - # If we want to go down, we also have to ensure that we are not yet at the - # end of the list. $aline is the position only relative to the window, so - # we have to compare $aline+$offset+1 agains the $count of QSOs... (+1 - # because $aline starts at 0, $count at 1) - elsif (($ch eq KEY_DOWN) && (($aline + $offset + 1) < $count)) { - # We are allowed to go down, but we have to check if we need to - # scroll or not. Scrolling is needed when $aline is 21. - if ($aline == ($yh-1)) { - $aline = 0; # next page, we start at beginning - $offset += ($yh-1); # increase the offset accordingly - } - else { # no scrolling needed - $aline++; # increase aline -> one row down - } - } - # Same story when we want to go up: Make sure that we are not at the - # beginning of the list. - elsif (($ch eq KEY_UP) && (($aline + $offset) > 0)) { - # We are allowed to go up, but we have to check if we need to - # scroll or not. Scrolling is needed when $aline is 0. - if ($aline == 0) { - $aline = ($yh-1); # next page, we start at beginning - $offset -= ($yh-1); # increase the offset accordingly - } - else { # no scrolling needed - $aline--; # increase aline -> one row down - } - } - - # PG DOWN is easier: We can scroll DOWN when there are more available - # lines than currently displayed: $offset+22. - elsif (($ch eq KEY_NPAGE) && ($offset+$yh < $count)) { - $offset += ($yh-1); # adjust offset - $aline = 0; # Start again at the first line + +do { # we start looping here + + # We query the database again, this time we select all the stuff we want to + # display. When we are in QSL write mode, select where QSLS = Q, else + # select by CALL. + # In the QSL receive mode it will be sorted by date, in QSL write mode by + # callsign, then date. + + my $lq; + + if ($write) { + $lq = $dbh->prepare("SELECT + `NR`, `CALL`, `NAME`, `QSLINFO`, `DATE`, + `T_ON`, `BAND`, `MODE`, `QSLS`, `QSLR`, `PWR`, `QTH`, `RSTS`, + `RSTR`, `REM`, `DXCC`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID` + FROM log_$mycall + WHERE `QSLS`='Q' OR `QSLS`='X' ORDER BY `CALL`, `DATE`, `T_ON` + LIMIT $offset, $yh"); + } + else { + $lq = $dbh->prepare("SELECT + `NR`, `CALL`, `NAME`, `QSLINFO`, `DATE`, + `T_ON`, `BAND`, `MODE`, `QSLS`, `QSLR`, `PWR`, `QTH`, `RSTS`, + `RSTR`, `REM`, `DXCC`, `IOTA`, `STATE`, `QSLRL`, `OPERATOR`, `GRID` + FROM log_$mycall + WHERE `CALL` LIKE + '\%$call\%' ORDER BY `DATE`, `T_ON` LIMIT $offset, $yh"); + + } + + $lq->execute() or die "Couldn't select log entries!"; # Execute the prepared Query + + # Temporary variables for every retrieved QSO ... + my ($nr, $fcall, $name, $qsli, $date, $time, $band, $mode, $qsls, $qslr, + $pwr, $qth, $rsts, $rstr, $rem, $dxcc, $iota, $state, $qslrl, $op, + $grid); + + $lq->bind_columns(\$nr,\$fcall,\$name,\$qsli,\$date,\$time,\$band, + \$mode,\$qsls,\$qslr,\$pwr,\$qth, \$rsts, \$rstr, + \$rem, \$dxcc, \$iota, \$state, \$qslrl, \$op, \$grid); + + my $y = 0; # y-position in $win + while ($lq->fetch()) { # more QSOs available + $time = substr($time, 0,5); # cut seconds from time + if ($qsls eq "X") { $qsls = "Y" } # see below + my $line=sprintf("%-6s %-12s %-11s%-9s%-8s %-5s %4s %4s %-4s %1s %1s ", + $nr, $fcall, $name, $qsli, $date, $time, $pwr, $band, $mode, $qsls, $qslr); + if ($qsls eq "Y") { $qsls = "X" } + if ($y == $aline) { # highlight line? + $chnr = $nr; # save number of aline + # save QSL status, depending on read/write mode. When in receive + # mode, also save qsl-sent status to toggle it when replying to + # incoming cards. + if ($write) { $qslstat = $qsls } + else { + $qslstat = $qslr; + $qslstat2 = $qsls; + } + addstr($win, $yh+1, 0, + sprintf("Additional QSO details: %6s - %-15s", $nr, $fcall)); + addstr($win, $yh+2, 0, + sprintf("RSTs: %-5s RSTr: %-5s QTH: %-18s DXCC: %4s IOTA: %-7s" + , $rsts, $rstr, $qth, $dxcc, $iota)); + addstr($win, $yh+3, 0, + sprintf("Power: %-4sW OP: %8s GRID: %-17s LOTW: %s", + $pwr, $op, $grid, $qslrl)); + addstr($win, $yh+4, 0, sprintf("Rem: %-60s", $rem)); + attron($win, COLOR_PAIR(3)); # highlight + } + addstr($win, $y, 0, $line); + attron($win, COLOR_PAIR(4)); + ($y < $yh) ? $y++ : last; # prints first $yh (22) rows + } # all QSOs printed + + for (;$y < $yh;$y++) { # for the remaining rows + addstr($win, $y, 0, " "x80); # fill with whitespace + } + + refresh($win); + + $ch = &getch2(); + + # Now start to analyse the input... + + # When Space is pressed, it means we toggle the QSL status of the current + # active QSO, NR saved in $chnr. In case that the user decides NOT to save + # the changes, we remember all changes that we made in the hash %changes, + # so they can be restored later. + # This is neccessary, because the DB is queried every time the cursor + # moves, so we cannot make changes in a temporary qso-array or so... + + if ($ch eq " ") { # SPACE BAR -> toggle QSL status + unless (defined $changes{$chnr}) { # we have NOT saved the original + $changes{$chnr} = $qslstat; # save it + } + + # We want to let the user *toggle* the status, so the change we make + # depends on the current value. + + if ($write) { # QSL write mode Q->Y + # "X" is used instead of "Y" as status, because if it's "Y", the + # QSO will not appear anymore in the list, when we update the + # screen... + + if ($qslstat eq "Q") { $qslstat = "X" } + elsif ($qslstat eq "X") { $qslstat = "Q"} + # Update database record... + $dbh->do("UPDATE log_$mycall SET QSLS='$qslstat' + WHERE NR='$chnr';"); + } + else { # QSL receive mode N->Y + if ($qslstat eq "N") { $qslstat = "Y" } + elsif ($qslstat eq "Y") { $qslstat = "N" } + $dbh->do("UPDATE log_$mycall SET QSLR='$qslstat' + WHERE NR='$chnr';"); + } + } # end of Spacebar handling + + # When pressing "s" in QSL-receive mode, toggle the QSl-sent flag. This is + # thought to be used for replying to incoming QSLs where no card has been + # sent. Toggling goes N->Y->Q + + elsif (($ch eq "s") && (not $write)) { + unless (defined $changes2{$chnr}) { # we have NOT saved the original + $changes2{$chnr} = $qslstat2; # save it + } + + if ($qslstat2 eq "N") { $qslstat2 = "X" } + elsif ($qslstat2 eq "X") { $qslstat2 = "Q" } + elsif ($qslstat2 eq "Q") { $qslstat2 = "N" } + $dbh->do("UPDATE log_$mycall SET QSLS='$qslstat2' + WHERE NR='$chnr';"); + } + + # If we want to go down, we also have to ensure that we are not yet at the + # end of the list. $aline is the position only relative to the window, so + # we have to compare $aline+$offset+1 agains the $count of QSOs... (+1 + # because $aline starts at 0, $count at 1) + elsif (($ch eq KEY_DOWN) && (($aline + $offset + 1) < $count)) { + # We are allowed to go down, but we have to check if we need to + # scroll or not. Scrolling is needed when $aline is 21. + if ($aline == ($yh-1)) { + $aline = 0; # next page, we start at beginning + $offset += ($yh-1); # increase the offset accordingly + } + else { # no scrolling needed + $aline++; # increase aline -> one row down + } + } + # Same story when we want to go up: Make sure that we are not at the + # beginning of the list. + elsif (($ch eq KEY_UP) && (($aline + $offset) > 0)) { + # We are allowed to go up, but we have to check if we need to + # scroll or not. Scrolling is needed when $aline is 0. + if ($aline == 0) { + $aline = ($yh-1); # next page, we start at beginning + $offset -= ($yh-1); # increase the offset accordingly + } + else { # no scrolling needed + $aline--; # increase aline -> one row down + } + } + + # PG DOWN is easier: We can scroll DOWN when there are more available + # lines than currently displayed: $offset+22. + elsif (($ch eq KEY_NPAGE) && ($offset+$yh < $count)) { + $offset += ($yh-1); # adjust offset + $aline = 0; # Start again at the first line flushinp(); - } - - # Same with UP. We can scroll up when $offset > 0 - elsif (($ch eq KEY_PPAGE) && ($offset > 0)) { - $offset -= ($yh-1); # adjust offset - $aline = ($yh-1); # Start again at the last line + } + + # Same with UP. We can scroll up when $offset > 0 + elsif (($ch eq KEY_PPAGE) && ($offset > 0)) { + $offset -= ($yh-1); # adjust offset + $aline = ($yh-1); # Start again at the last line flushinp(); - } - - # F1 => Back to the main menu. Return 2 for Status. - elsif ($ch eq KEY_F(1)) { - my $k = 'y'; - if (keys %changes) { - $k = &askconfirmation("Really save and go back to menu? [y/N]", - 'y|n|\s|\n'); - } - - if ($k =~ /y/i) { - # changed QSL sent flags back to Y - $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS='X';"); - return 2; - } - } - - # F2 => We are done. Changes to the DB are saved, we can go back. - # return 3 -> stay in QSL mode, wait for new callsign WHEN in receive mode - # return 2 -> back to main menu when in write mode. before change all - # QSL-sent flags that are "X" to "Y". the X is used temporarily within this - # sub, because after updating the screen, "Y" would not be displayed - # anymore... - - elsif ($ch eq KEY_F(2)) { - $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS='X';"); - if ($write) { - return 2; - } - else { return 3 } - } - - # F3 => Cancel. This means we must restore the original QSL status again. - # We have saved the changes we made in %changes. - elsif ($ch eq KEY_F(3)) { - my $k = 'y'; - if (keys %changes) { - $k = &askconfirmation("Really cancel changes and go to menu? [y/N]", - 'y|n|\s|\n'); - } - - if ($k =~ /y/i) { - # Iterate through the hash where the changes were saved and restore it - # in the database... - while ((my $nr, my $qsl) = each %changes) { - # Depending on the mode (QSL write or receive), update DB fields - if ($write) { - $dbh->do("UPDATE log_$mycall SET QSLS='$qsl' WHERE NR='$nr';"); - } - else { - $dbh->do("UPDATE log_$mycall SET QSLR='$qsl' WHERE NR='$nr';"); - } - } - # Same for %changes2, the QSL-S changes while in QSL-R mode (replying) - while ((my $nr, my $qsl) = each %changes2) { - # Depending on the mode (QSL write or receive), update DB fields - if ($write) { - # Impossible here :) - } - else { - $dbh->do("UPDATE log_$mycall SET QSLS='$qsl' WHERE NR='$nr';"); - } - } - if ($write) { return 2 } # write -> Back to main menu - else { return 3 } # receive -> QSL rx mode - } # if $k =~ y - } - - # F12 -> Exit - elsif ($ch eq KEY_F(12)) { - endwin(); - exit; - } - -} while (1); # loop until end of time - + } + + # F1 => Back to the main menu. Return 2 for Status. + elsif ($ch eq KEY_F(1)) { + my $k = 'y'; + if (keys %changes) { + $k = &askconfirmation("Really save and go back to menu? [y/N]", + 'y|n|\s|\n'); + } + + if ($k =~ /y/i) { + # changed QSL sent flags back to Y + $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS='X';"); + return 2; + } + } + + # F2 => We are done. Changes to the DB are saved, we can go back. + # return 3 -> stay in QSL mode, wait for new callsign WHEN in receive mode + # return 2 -> back to main menu when in write mode. before change all + # QSL-sent flags that are "X" to "Y". the X is used temporarily within this + # sub, because after updating the screen, "Y" would not be displayed + # anymore... + + elsif ($ch eq KEY_F(2)) { + $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS='X';"); + if ($write) { + return 2; + } + else { return 3 } + } + + # F3 => Cancel. This means we must restore the original QSL status again. + # We have saved the changes we made in %changes. + elsif ($ch eq KEY_F(3)) { + my $k = 'y'; + if (keys %changes) { + $k = &askconfirmation("Really cancel changes and go to menu? [y/N]", + 'y|n|\s|\n'); + } + + if ($k =~ /y/i) { + # Iterate through the hash where the changes were saved and restore it + # in the database... + while ((my $nr, my $qsl) = each %changes) { + # Depending on the mode (QSL write or receive), update DB fields + if ($write) { + $dbh->do("UPDATE log_$mycall SET QSLS='$qsl' WHERE NR='$nr';"); + } + else { + $dbh->do("UPDATE log_$mycall SET QSLR='$qsl' WHERE NR='$nr';"); + } + } + # Same for %changes2, the QSL-S changes while in QSL-R mode (replying) + while ((my $nr, my $qsl) = each %changes2) { + # Depending on the mode (QSL write or receive), update DB fields + if ($write) { + # Impossible here :) + } + else { + $dbh->do("UPDATE log_$mycall SET QSLS='$qsl' WHERE NR='$nr';"); + } + } + if ($write) { return 2 } # write -> Back to main menu + else { return 3 } # receive -> QSL rx mode + } # if $k =~ y + } + + # F12 -> Exit + elsif ($ch eq KEY_F(12)) { + endwin(); + exit; + } + +} while (1); # loop until end of time + } # end of toggleqsl @@ -2726,25 +2726,25 @@ do { # we start looping here ############################################################################## sub onlinelog { - my @qso; # Every QSO we fetch from the DB will be stored here - my $nr; # Number of QSOs that are exported. + my @qso; # Every QSO we fetch from the DB will be stored here + my $nr; # Number of QSOs that are exported. - open ONLINELOG, ">$directory/$mycall.log"; + open ONLINELOG, ">$directory/$mycall.log"; - # We query the database for the fields specified in $onlinedata (by default - # or from the config file). - - my $ol = $dbh->prepare("SELECT $onlinedata FROM log_$mycall ORDER BY `DATE`"); - $ol->execute or die DBI->errstr; # Execute the query + # We query the database for the fields specified in $onlinedata (by default + # or from the config file). + + my $ol = $dbh->prepare("SELECT $onlinedata FROM log_$mycall ORDER BY `DATE`"); + $ol->execute or die DBI->errstr; # Execute the query - while (@qso = $ol->fetchrow_array()) { # Fetch the selected data into @qso - my $line = join ('~', @qso); # assemble lines, ~-separated - print ONLINELOG $line."\n"; # write to log - $nr++; # increase number of QSOs... - } - close ONLINELOG; + while (@qso = $ol->fetchrow_array()) { # Fetch the selected data into @qso + my $line = join ('~', @qso); # assemble lines, ~-separated + print ONLINELOG $line."\n"; # write to log + $nr++; # increase number of QSOs... + } + close ONLINELOG; -return $nr; # return number of exported QSOs +return $nr; # return number of exported QSOs } @@ -2777,139 +2777,139 @@ return $nr; # return number of exported QSOs ############################################################################## sub preparelabels { - my %calls; # call hash, see above - my %labels; # label hash, see above - my $labeltype=$_[0]; # filename of the label type - my $daterange= $_[1]; # date range for exporting - my $qsos; # number of QSOs per label - my $template; # LaTeX template of a label, read from file - + my %calls; # call hash, see above + my %labels; # label hash, see above + my $labeltype=$_[0]; # filename of the label type + my $daterange= $_[1]; # date range for exporting + my $qsos; # number of QSOs per label + my $template; # LaTeX template of a label, read from file + # We read the contents of the label file. for this part, only the LaTeX code # and the number of QSO lines is needed. - - open QSL, $labeltype; # Open the label file - while (defined (my $line = )) { # Read line into $line - if ($line =~ /^% QSOS=(\d)/) { # QSOs per label - $qsos = $1; - } - elsif ($line =~ /^%/) {} # comment, skip it - else { # must be TeX now. - $template .= $line; # add line to label template - } - } - close QSL; + + open QSL, $labeltype; # Open the label file + while (defined (my $line = )) { # Read line into $line + if ($line =~ /^% QSOS=(\d)/) { # QSOs per label + $qsos = $1; + } + elsif ($line =~ /^%/) {} # comment, skip it + else { # must be TeX now. + $template .= $line; # add line to label template + } + } + close QSL; # Now the log is queried for queued QSLs.. - my $queue = $dbh->prepare("SELECT `CALL`, `NAME`, `DATE`, `T_ON`, `BAND`, - `MODE`, `RSTS`, `PWR`, `QSLINFO`, `QSLR`, `OPERATOR` FROM - log_$mycall WHERE `QSLS`='Q' AND $daterange - ORDER BY `CALL`, `DATE`, `T_ON`"); - - my $x = $queue->execute(); # Execute Query - - my ($call, $name, $date, $time, $band, $mode, $rst, $pwr, $mgr, $qslr, $op); - $queue->bind_columns(\$call,\$name,\$date,\$time,\$band,\$mode, - \$rst,\$pwr,\$mgr,\$qslr,\$op); - - # Now we are fetching row by row of the data which has to be put into the - # %labels hash. - while (my @qso = $queue->fetchrow_array()) { # @qso to put into QSL hash - # Firstly, the time format shall be changed to HHMM and the band - # should get an additional "m" or "cm" - - $time = substr($time,0,5); # cut seconds - if ($band > 1) { - $band = $band."m"; # add m - } - else { - $band *= 100; # convert to cm - $band = $band."cm"; # add cm - } - - # Change QSL-received information. Y = TNX, N = PSE - - if ($qslr eq 'Y') { $qslr = 'TNX'; } - else { $qslr = 'PSE';} - - my $scall=$call; - # $scall is the "sort call". Usually it's the same as the call, but if - # there is a QSLINFO, it will replaced by it plus the callsign of the - # recipient. $scall is the key for the # hash. - - if ($mgr) { # There is a manager - $scall = $mgr.$call; # sort by manager call+call - } - - - # Check if key $scall already exists in the %calls hash, if not add it - # if it exists, check if label is full, if so make new one, otherwise - # go on. (Works with up to 10 labels, but that should be OK :) - if (exists $calls{$scall}) { # call exists? - if (substr($labels{$calls{$scall}},0,1)==$qsos){# label full? - my $nr = substr($calls{$scall},-1,1); # nr of labels - substr($calls{$scall},-1,1) = ($nr+1); # increase # of lab - $labels{$calls{$scall}} = "0".$template; # make new label - } - } - else { # call does not yet exist.. - $calls{$scall} = $scall."0"; # 1st label for $call - $labels{$calls{$scall}} = "0".$template; # create label,0 Qs - } - - # now we are ensured that we can write the QSO line to the label hash - # at $label{$calls{$call}}. OK, that's too much typing. So we make a - # reference to it; we can easily access the label with $$lr now. - - my $lr = \$labels{$calls{$scall}}; - - # If it's the first row we write on the label, also the CALL, MANAGER, - # MYCALL and eventually NAME have to be added: - - if (substr($$lr,0,1) eq "0") { # first line - my ($call, $mgr) = ($call, $mgr); # local copies - $call =~ s/0/\\O{}/g; # replace 0 with slashed O - $mgr =~ s/0/\\O{}/g; # replace 0 with slashed O - $$lr =~ s/HISCALL/$call/; # replace things - $$lr =~ s/MANAGER/$mgr/; - $$lr =~ s/MYCALL/\U$mycall/; - $$lr =~ s/_/\//g; # _ to / - $$lr =~ s/NAME/$name/; - $$lr =~ s/TXPOWER/$pwr/; - $$lr =~ s/OPERATOR/$op/; - } - - # In every case we have to replace the fields DATE, TIME, BAND, MODE, - # RST of the current line. The number of the line is the first byte of - # the label + 1 - - my $nr = substr($$lr,0,1); # Number of QSOs written - $nr++; # we write another line - $$lr =~s/DATE$nr/$date/; # replace things. - $$lr =~s/TIME$nr/$time/; - $$lr =~s/BAND$nr/$band/; - $$lr =~s/MODE$nr/$mode/; - $$lr =~s/RST$nr/$rst/; - $$lr =~s/QSLR$nr/$qslr/; - substr($$lr,0,1) = $nr; # increase nr of QSOs on label - - } # end of while for reading log line + my $queue = $dbh->prepare("SELECT `CALL`, `NAME`, `DATE`, `T_ON`, `BAND`, + `MODE`, `RSTS`, `PWR`, `QSLINFO`, `QSLR`, `OPERATOR` FROM + log_$mycall WHERE `QSLS`='Q' AND $daterange + ORDER BY `CALL`, `DATE`, `T_ON`"); + + my $x = $queue->execute(); # Execute Query + + my ($call, $name, $date, $time, $band, $mode, $rst, $pwr, $mgr, $qslr, $op); + $queue->bind_columns(\$call,\$name,\$date,\$time,\$band,\$mode, + \$rst,\$pwr,\$mgr,\$qslr,\$op); + + # Now we are fetching row by row of the data which has to be put into the + # %labels hash. + while (my @qso = $queue->fetchrow_array()) { # @qso to put into QSL hash + # Firstly, the time format shall be changed to HHMM and the band + # should get an additional "m" or "cm" + + $time = substr($time,0,5); # cut seconds + if ($band > 1) { + $band = $band."m"; # add m + } + else { + $band *= 100; # convert to cm + $band = $band."cm"; # add cm + } + + # Change QSL-received information. Y = TNX, N = PSE + + if ($qslr eq 'Y') { $qslr = 'TNX'; } + else { $qslr = 'PSE';} + + my $scall=$call; + # $scall is the "sort call". Usually it's the same as the call, but if + # there is a QSLINFO, it will replaced by it plus the callsign of the + # recipient. $scall is the key for the # hash. + + if ($mgr) { # There is a manager + $scall = $mgr.$call; # sort by manager call+call + } + + + # Check if key $scall already exists in the %calls hash, if not add it + # if it exists, check if label is full, if so make new one, otherwise + # go on. (Works with up to 10 labels, but that should be OK :) + if (exists $calls{$scall}) { # call exists? + if (substr($labels{$calls{$scall}},0,1)==$qsos){# label full? + my $nr = substr($calls{$scall},-1,1); # nr of labels + substr($calls{$scall},-1,1) = ($nr+1); # increase # of lab + $labels{$calls{$scall}} = "0".$template; # make new label + } + } + else { # call does not yet exist.. + $calls{$scall} = $scall."0"; # 1st label for $call + $labels{$calls{$scall}} = "0".$template; # create label,0 Qs + } + + # now we are ensured that we can write the QSO line to the label hash + # at $label{$calls{$call}}. OK, that's too much typing. So we make a + # reference to it; we can easily access the label with $$lr now. + + my $lr = \$labels{$calls{$scall}}; + + # If it's the first row we write on the label, also the CALL, MANAGER, + # MYCALL and eventually NAME have to be added: + + if (substr($$lr,0,1) eq "0") { # first line + my ($call, $mgr) = ($call, $mgr); # local copies + $call =~ s/0/\\O{}/g; # replace 0 with slashed O + $mgr =~ s/0/\\O{}/g; # replace 0 with slashed O + $$lr =~ s/HISCALL/$call/; # replace things + $$lr =~ s/MANAGER/$mgr/; + $$lr =~ s/MYCALL/\U$mycall/; + $$lr =~ s/_/\//g; # _ to / + $$lr =~ s/NAME/$name/; + $$lr =~ s/TXPOWER/$pwr/; + $$lr =~ s/OPERATOR/$op/; + } + + # In every case we have to replace the fields DATE, TIME, BAND, MODE, + # RST of the current line. The number of the line is the first byte of + # the label + 1 + + my $nr = substr($$lr,0,1); # Number of QSOs written + $nr++; # we write another line + $$lr =~s/DATE$nr/$date/; # replace things. + $$lr =~s/TIME$nr/$time/; + $$lr =~s/BAND$nr/$band/; + $$lr =~s/MODE$nr/$mode/; + $$lr =~s/RST$nr/$rst/; + $$lr =~s/QSLR$nr/$qslr/; + substr($$lr,0,1) = $nr; # increase nr of QSOs on label + + } # end of while for reading log line # OK, gone through all the lines now and added them to labels. Now delete all # placeholders for QSO lines which were not used. foreach my $key (my @k = keys(%labels)) { - $labels{$key} =~ s/DATE\d&/ &/g; # kill placeholders - $labels{$key} =~ s/&TIME\d&/& &/g; - $labels{$key} =~ s/&BAND\d&/& &/g; - $labels{$key} =~ s/&MODE\d&/& &/g; - $labels{$key} =~ s/&RST\d/& /g; - $labels{$key} =~ s/&QSLR\d/& /g; + $labels{$key} =~ s/DATE\d&/ &/g; # kill placeholders + $labels{$key} =~ s/&TIME\d&/& &/g; + $labels{$key} =~ s/&BAND\d&/& &/g; + $labels{$key} =~ s/&MODE\d&/& &/g; + $labels{$key} =~ s/&RST\d/& /g; + $labels{$key} =~ s/&QSLR\d/& /g; } -return %labels; - -} # end of preparelabels +return %labels; + +} # end of preparelabels ############################################################################## # labeltex This sub receives a reference to a hash of QSL labels, @@ -2919,56 +2919,56 @@ return %labels; ############################################################################## sub labeltex { - my %labels = %{$_[0]}; # labels - my @keys; # keys of the label hash - my $start=($_[2]-1); # startlabel where to start printing - my $lnr; # label number absolute - my $latex; # the string which will contain the latex document - my $labeltype=$_[1]; # the type of the QSL label - my $width; # width of the QSL label in mm - my $height; # height of the QSL label in mm - my $topmargin; # top margin of the label sheet - my $leftmargin; # left margin of the label sheet - my $rows; # number of label rows - my $cols; # number of label columns - my $orientation = "portrait"; # page orientation - my $paperheight = 297; # height of oriented paper - my $paperwidth = 210; # width of oriented paper - + my %labels = %{$_[0]}; # labels + my @keys; # keys of the label hash + my $start=($_[2]-1); # startlabel where to start printing + my $lnr; # label number absolute + my $latex; # the string which will contain the latex document + my $labeltype=$_[1]; # the type of the QSL label + my $width; # width of the QSL label in mm + my $height; # height of the QSL label in mm + my $topmargin; # top margin of the label sheet + my $leftmargin; # left margin of the label sheet + my $rows; # number of label rows + my $cols; # number of label columns + my $orientation = "portrait"; # page orientation + my $paperheight = 297; # height of oriented paper + my $paperwidth = 210; # width of oriented paper + # Read label geometry from the definition file - - open QSL, $labeltype; # Open the label file - while (defined (my $line = )) { # Read line into $line - if ($line =~ /^% WIDTH=([\d.]+)/) { $width= $1; } - elsif ($line =~ /^% HEIGHT=([\d.]+)/) { $height= $1; } - elsif ($line =~ /^% TOPMARGIN=([\d.]+)/) { $topmargin= $1; } - elsif ($line =~ /^% LEFTMARGIN=([\d.]+)/) { $leftmargin= $1; } - elsif ($line =~ /^% ROWS=(\d+)/) { $rows= $1; } - elsif ($line =~ /^% COLS=(\d+)/) { $cols= $1; } - elsif ($line =~ /^% ORIENTATION=(\w+)/) { $orientation= $1; } - } - close QSL; - # adjust height to orientation - if ($orientation eq "landscape") { - $paperheight = 210; - $paperwidth = 297; - } + + open QSL, $labeltype; # Open the label file + while (defined (my $line = )) { # Read line into $line + if ($line =~ /^% WIDTH=([\d.]+)/) { $width= $1; } + elsif ($line =~ /^% HEIGHT=([\d.]+)/) { $height= $1; } + elsif ($line =~ /^% TOPMARGIN=([\d.]+)/) { $topmargin= $1; } + elsif ($line =~ /^% LEFTMARGIN=([\d.]+)/) { $leftmargin= $1; } + elsif ($line =~ /^% ROWS=(\d+)/) { $rows= $1; } + elsif ($line =~ /^% COLS=(\d+)/) { $cols= $1; } + elsif ($line =~ /^% ORIENTATION=(\w+)/) { $orientation= $1; } + } + close QSL; + # adjust height to orientation + if ($orientation eq "landscape") { + $paperheight = 210; + $paperwidth = 297; + } # We start assembling the latex string. First we add the header, which will be # the same for all labels. I assume that all labels come on A4 paper. The # header should have all the packages needed. - $latex .= '\documentclass[a4paper]{article} - \pagestyle{empty} - \usepackage{latexsym} - \usepackage{graphicx} - \usepackage[margin=0cm,noheadfoot,'.$orientation.']{geometry} - \renewcommand{\familydefault}{\sfdefault} - \setlength{\parindent}{0pt} - \begin{document} - \setlength{\unitlength}{1mm} - \begin{picture}('."$paperwidth,$paperheight)\n"; - + $latex .= '\documentclass[a4paper]{article} + \pagestyle{empty} + \usepackage{latexsym} + \usepackage{graphicx} + \usepackage[margin=0cm,noheadfoot,'.$orientation.']{geometry} + \renewcommand{\familydefault}{\sfdefault} + \setlength{\parindent}{0pt} + \begin{document} + \setlength{\unitlength}{1mm} + \begin{picture}('."$paperwidth,$paperheight)\n"; + # The QSL cards should be printed in alphabetical order. The keys of the # %labels hash are the callsigns plus attached number of label, so they can be # used to sort. ASCIIbetical sort is OK since there are only [0-9A-Z]. @@ -2987,51 +2987,51 @@ my ($page, $row, $col) = (1,1,1); # blank page. unless ($start > ($cols * $rows)) { -while ($start > $cols) { - $start-= $cols; # next row - $row++; +while ($start > $cols) { + $start-= $cols; # next row + $row++; } -$col += $start-1; # go to proper column +$col += $start-1; # go to proper column } foreach my $key (@keys) { - $lnr++; # next label - $col++; # next column - if ($col > $cols) { # over end of a row - $col = 1; # start at 1st column again - $row += 1; # increase row - } - if ($row > $rows) { # over rows! - $row = 1; # start at first row again - $page +=1; # increase page, write to doc. - $latex .= "\\end{picture}\n\\newpage\n\\begin{picture}($paperwidth,$paperheight)"; - } - - # Now the position of the label on the sheet has to be calculated from the - # row and col information. the point we are looking for is the lower left - # corner of the label. - - my $x = $leftmargin; # The x position is always shifted my leftmarg - $x += ($col-1)*$width; # add the width of the labels - - my $y = $paperheight - $topmargin; # y position starts shifted by topmargin - $y -= ($row)*$height; # go down by $height * $row - - # first letter in the label code is not needed here, it is the number of - # QSOs on that label. Put the rest to the $latex variable which will be the - # full LaTeX source, at the proper position $x, $y. - $latex .= "\n"."\\put($x,$y){".substr($labels{$key},1,)."}"; + $lnr++; # next label + $col++; # next column + if ($col > $cols) { # over end of a row + $col = 1; # start at 1st column again + $row += 1; # increase row + } + if ($row > $rows) { # over rows! + $row = 1; # start at first row again + $page +=1; # increase page, write to doc. + $latex .= "\\end{picture}\n\\newpage\n\\begin{picture}($paperwidth,$paperheight)"; + } + + # Now the position of the label on the sheet has to be calculated from the + # row and col information. the point we are looking for is the lower left + # corner of the label. + + my $x = $leftmargin; # The x position is always shifted my leftmarg + $x += ($col-1)*$width; # add the width of the labels + + my $y = $paperheight - $topmargin; # y position starts shifted by topmargin + $y -= ($row)*$height; # go down by $height * $row + + # first letter in the label code is not needed here, it is the number of + # QSOs on that label. Put the rest to the $latex variable which will be the + # full LaTeX source, at the proper position $x, $y. + $latex .= "\n"."\\put($x,$y){".substr($labels{$key},1,)."}"; } # All labels are written now. we finish the document. Attach number of labels # and pages as % comment in the latex file. - $latex .= "\\end{picture}\n\\end{document}\n\% $lnr $page"; + $latex .= "\\end{picture}\n\\end{document}\n\% $lnr $page"; -return $latex; # return the document - -} # labeltex ends here +return $latex; # return the document + +} # labeltex ends here ############################################################################## # emptyqslqueue - After successfully printing QSL labels, all queued QSLs @@ -3039,7 +3039,7 @@ return $latex; # return the document ############################################################################## sub emptyqslqueue { - return $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS ='Q';"); + return $dbh->do("UPDATE log_$mycall SET QSLS='Y' WHERE QSLS ='Q';"); } ############################################################################## @@ -3053,140 +3053,140 @@ sub emptyqslqueue { ############################################################################## sub adifexport { - my $filename = $_[0]; # Where to save the exported data - my $export = $_[1]; # 'lotw' or 'adi'. - my $daterange= $_[2]; # date range for exporting - my $nr=0; # number of QSOs exported. return value - my $sql = 'WHERE '; - my @q; # QSOs from the DB.. - - open ADIF, ">$filename"; # Open ADIF file - - print ADIF "Exported from the logbook of $mycall by YFKlog.\n"; - - $sql .= " QSLRL = 'N' AND " if ($export eq 'lotw'); - - $sql .= $daterange; - - my $adif = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, - `MODE`, `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, - `PWR`, `PFX`, `CONT`, `QSLINFO`, `CQZ`, `ITUZ`, `IOTA`, `STATE`, - `OPERATOR`, `GRID` FROM log_$mycall $sql"); - - $adif->execute(); - - # Fetching every line into the @qso array, then printing it into the file. - while (@q = $adif->fetchrow_array()) { - # increase counter... - - $nr++; - - # Change the date-format from YYYY-MM-DD into YYYMMDD - substr($q[1],4,1) = ''; # delete first hyphen - substr($q[1],6,1) = ''; # deltete second hyphen - - # change time format from hh:mm:ss to HHMMSS - substr($q[2],2,1)=''; substr($q[2],4,1)=''; # time on - substr($q[3],2,1)=''; substr($q[3],4,1)=''; # time off - - # check if band is millimeters, meters or centimeters - if ($q[4] < 0.01) { # mm (47GHz and up) - $q[4] *= 1000; - $q[4] .= "mm"; - } - elsif($q[4] < 1) { # centimeters - $q[4] *= 100; # convert to meters - $q[4] .="cm"; # add cm - } - else { # meters - $q[4] .="m"; - } - - # First print those fields which *have* to exist: - print ADIF "\n\n$q[0] "; - print ADIF "$q[1] "; - print ADIF "$q[2] "; - print ADIF "$q[3] "; - print ADIF "$q[4] "; - print ADIF "$q[5] \n"; - print ADIF "$q[10] "; - print ADIF "$q[11] "; - print ADIF "$q[8] "; - print ADIF "$q[9] "; - print ADIF "$q[14] "; - print ADIF "$q[15] "; - - # now the fields which might be empty - unless ($q[6] eq '') { - print ADIF "$q[6] "; - } - unless ($q[7] eq '') { - print ADIF "$q[7] \n"; - } - unless ($q[12] eq '') { - print ADIF "$q[12] "; - } - unless ($q[13] eq '') { - print ADIF "$q[13] "; - } - unless ($q[16] eq '') { - print ADIF "$q[16] "; - } - unless ($q[17] eq '') { - print ADIF "$q[17] "; - } - unless ($q[18] eq '') { - print ADIF "$q[18] "; - } - unless ($q[19] eq '') { - print ADIF "$q[19] "; - } - unless ($q[20] eq '') { - print ADIF "$q[20] "; - } - unless ($q[21] eq '') { - print ADIF "$q[21] "; - } - unless ($q[22] eq '') { - print ADIF "$q[22] "; - } - print ADIF ''; # QSO done - } # no more lines to fetch.. - - close ADIF; - - $dbh->do("UPDATE log_$mycall set qslrl='R' where qslrl='N'") if - ($export eq 'lotw'); - - return $nr; # return number of exported QSOs... -} # end of ADIF export + my $filename = $_[0]; # Where to save the exported data + my $export = $_[1]; # 'lotw' or 'adi'. + my $daterange= $_[2]; # date range for exporting + my $nr=0; # number of QSOs exported. return value + my $sql = 'WHERE '; + my @q; # QSOs from the DB.. + + open ADIF, ">$filename"; # Open ADIF file + + print ADIF "Exported from the logbook of $mycall by YFKlog.\n"; + + $sql .= " QSLRL = 'N' AND " if ($export eq 'lotw'); + + $sql .= $daterange; + + my $adif = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, + `MODE`, `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, + `PWR`, `PFX`, `CONT`, `QSLINFO`, `CQZ`, `ITUZ`, `IOTA`, `STATE`, + `OPERATOR`, `GRID` FROM log_$mycall $sql"); + + $adif->execute(); + + # Fetching every line into the @qso array, then printing it into the file. + while (@q = $adif->fetchrow_array()) { + # increase counter... + + $nr++; + + # Change the date-format from YYYY-MM-DD into YYYMMDD + substr($q[1],4,1) = ''; # delete first hyphen + substr($q[1],6,1) = ''; # deltete second hyphen + + # change time format from hh:mm:ss to HHMMSS + substr($q[2],2,1)=''; substr($q[2],4,1)=''; # time on + substr($q[3],2,1)=''; substr($q[3],4,1)=''; # time off + + # check if band is millimeters, meters or centimeters + if ($q[4] < 0.01) { # mm (47GHz and up) + $q[4] *= 1000; + $q[4] .= "mm"; + } + elsif($q[4] < 1) { # centimeters + $q[4] *= 100; # convert to meters + $q[4] .="cm"; # add cm + } + else { # meters + $q[4] .="m"; + } + + # First print those fields which *have* to exist: + print ADIF "\n\n$q[0] "; + print ADIF "$q[1] "; + print ADIF "$q[2] "; + print ADIF "$q[3] "; + print ADIF "$q[4] "; + print ADIF "$q[5] \n"; + print ADIF "$q[10] "; + print ADIF "$q[11] "; + print ADIF "$q[8] "; + print ADIF "$q[9] "; + print ADIF "$q[14] "; + print ADIF "$q[15] "; + + # now the fields which might be empty + unless ($q[6] eq '') { + print ADIF "$q[6] "; + } + unless ($q[7] eq '') { + print ADIF "$q[7] \n"; + } + unless ($q[12] eq '') { + print ADIF "$q[12] "; + } + unless ($q[13] eq '') { + print ADIF "$q[13] "; + } + unless ($q[16] eq '') { + print ADIF "$q[16] "; + } + unless ($q[17] eq '') { + print ADIF "$q[17] "; + } + unless ($q[18] eq '') { + print ADIF "$q[18] "; + } + unless ($q[19] eq '') { + print ADIF "$q[19] "; + } + unless ($q[20] eq '') { + print ADIF "$q[20] "; + } + unless ($q[21] eq '') { + print ADIF "$q[21] "; + } + unless ($q[22] eq '') { + print ADIF "$q[22] "; + } + print ADIF ''; # QSO done + } # no more lines to fetch.. + + close ADIF; + + $dbh->do("UPDATE log_$mycall set qslrl='R' where qslrl='N'") if + ($export eq 'lotw'); + + return $nr; # return number of exported QSOs... +} # end of ADIF export ############################################################################## # ftpupload - upload dj1yfk.log to the place specified in the config file ############################################################################## sub ftpupload { - # Trying to open a FTP connection - - my $ftp = Net::FTP->new($ftpserver, Timeout => 120, Port => $ftpport, - Debug => 0, Hash => 0); + # Trying to open a FTP connection + + my $ftp = Net::FTP->new($ftpserver, Timeout => 120, Port => $ftpport, + Debug => 0, Hash => 0); - # If the connection fails, undef is returned.. - unless (defined $ftp) { - return "Sorry: $@"; - } - - # at this point, the FTP connection is ok, so we log in - - $ftp->login($ftpuser, $ftppass) || return "FTP login failed. $!"; + # If the connection fails, undef is returned.. + unless (defined $ftp) { + return "Sorry: $@"; + } + + # at this point, the FTP connection is ok, so we log in + + $ftp->login($ftpuser, $ftppass) || return "FTP login failed. $!"; - $ftp->cwd($ftpdir); # change into the log directory + $ftp->cwd($ftpdir); # change into the log directory - $ftp->put($directory.'/'.$mycall.'.log') || return "Cannot put $mycall.log, $!"; + $ftp->put($directory.'/'.$mycall.'.log') || return "Cannot put $mycall.log, $!"; - $ftp->quit(); + $ftp->quit(); - return "Log uploaded successfully to $ftpdir$mycall.log!"; + return "Log uploaded successfully to $ftpdir$mycall.log!"; } # end of ftp upload @@ -3205,22 +3205,22 @@ sub ftpupload { sub adifimport { -my $win = $_[1]; # Window to print status info.. -my $filename=$_[0]; # the ADIF-File -my $fullline; # We need to put together several lines until - # a occurs -my $field=""; # adif field name -my $content=""; # adif field content -my $am=0; # adif mode. 1 = read field name, 2 = read - # length, 3 = read content, 0 = nothing -my $len=""; # length of the field to read. -my @qso; # array which holds QSO-hashes -my $nr=0; # number of imported lines -my $err=0; # number of errors during import -my $errmsg=''; # reason of error -my $war=0; # number of warnings (unk. fields) -my $ch; # process adif-file $ch by $ch.. -my $header=1; # while header=1, we are still before +my $win = $_[1]; # Window to print status info.. +my $filename=$_[0]; # the ADIF-File +my $fullline; # We need to put together several lines until + # a occurs +my $field=""; # adif field name +my $content=""; # adif field content +my $am=0; # adif mode. 1 = read field name, 2 = read + # length, 3 = read content, 0 = nothing +my $len=""; # length of the field to read. +my @qso; # array which holds QSO-hashes +my $nr=0; # number of imported lines +my $err=0; # number of errors during import +my $errmsg=''; # reason of error +my $war=0; # number of warnings (unk. fields) +my $ch; # process adif-file $ch by $ch.. +my $header=1; # while header=1, we are still before my $parsecount=1; $filename =~ /([^\/]+)$/; @@ -3237,93 +3237,93 @@ open ADIF, $filename; while (my $line = ) { - map {s/\r//g;} ($line); # cope with DOS linebreaks - - # As long as the current position is in the header, we discard the lines - # This is the case as long has $header is 1; it is set to 0 as soon as a - # is found. - if ($header) { # we are in the header.. - if ($line =~ //i) { # end of header? - $header = 0; - } - next; # process next line - } - - # Now assemble a full line, containing a full QSO until - unless ($line =~ /(\s+)?$/i) { # line ends here - $fullline .= $line; # add line to full line - } - else { # we have a -> full line - $fullline .= $line; - $fullline =~ s///i; # cut EOR - $nr++; # increase line counter - my $qh = {}; # anonymous qso-hash - while (($ch = substr($fullline,0,1)) ne "") { # fullline has a letter - $fullline = substr($fullline,1,); # cut first letter - - # Now the string $fullline is parsed letter by letter. depending on - # it's content and the adif mode in which we are, the $ch is either - # discarded (for <,> and :) or added to either the $field, $length - # or $content variable. - # This is a typical ADIF line and the modes in which we are while - # parsing it: - # - # DL1AA 20050401 ... - #01111122333333011111223333333330... - - # If the character is a "<" AND we are in mode 0, it means a new - # field definition starts. It's important to check that we are - # actually in the mode 0 because otherwise a "<" in a comment field - # would be mistaken for the start of a new field. - if (($ch eq "<") && ($am == 0)) { # new field starts - $field = ""; # delete old field - $len=""; # delete old length - $am = 1; # adifmode = 1 = read field - } - # The field name is read. Only allowed characters are letters and - # underscores. The read character is added to the field-name - elsif (($ch =~ /[A-Za-z_]/) && ($am == 1)) { # read field name - $field .= $ch; - } - # When we are reading the field definition (am = 1) and a colon - # occurs, it marks the end of the field def and after it the length - # starts. so we switch to am=2, which is the length mode - elsif (($ch eq ":") && ($am == 1)) { # field over, now length - $am = 2; # ==> mode 2 - } - # we are in length-mode, and add every number that comes our way to - # the $len variable. - elsif (($ch =~ /\d/) && ($am == 2)) { # read length; - $len .= $ch; # add length - } - # we are in length mode and a ">" comes our way, meaning that we - # have to start reading the content of the field from now on. so - # switch to mode 3, except when field length is zero. then $am - # becomes 0 (look for next field to start). - elsif (($ch eq ">") && ($am == 2)) { # length over - if ($len eq '0') { $am = 0; next } # no length -> read next - $am = 3; # read field content - } - # last check: we are in mode to read content - # within this check we also check if the maximum length has been - # reaced, if so, we save the information into an array of hashes. - - elsif (($am == 3) && ((length($content)) < $len)) { - $content .= $ch; - if (length($content) == $len) { - $am = 0; # field / value pair is done - # print "$nr: >$field< ---> >$content<\n"; - $qh->{"\L$field"} = $content; # fieldname lowercase - $field=""; - $content=""; - } - } # main $ch-processing ends here - } # while loop to iterate through $fullline ends here - push @qso, $qh; # add ref to qso-hash to @qso array. - addstr($win,0,50, $parsecount." "x80) unless ($parsecount % 100); - refresh($win) unless ($parsecount % 100); - $parsecount++; - } # else -> fullline complete ends here + map {s/\r//g;} ($line); # cope with DOS linebreaks + + # As long as the current position is in the header, we discard the lines + # This is the case as long has $header is 1; it is set to 0 as soon as a + # is found. + if ($header) { # we are in the header.. + if ($line =~ //i) { # end of header? + $header = 0; + } + next; # process next line + } + + # Now assemble a full line, containing a full QSO until + unless ($line =~ /(\s+)?$/i) { # line ends here + $fullline .= $line; # add line to full line + } + else { # we have a -> full line + $fullline .= $line; + $fullline =~ s///i; # cut EOR + $nr++; # increase line counter + my $qh = {}; # anonymous qso-hash + while (($ch = substr($fullline,0,1)) ne "") { # fullline has a letter + $fullline = substr($fullline,1,); # cut first letter + + # Now the string $fullline is parsed letter by letter. depending on + # it's content and the adif mode in which we are, the $ch is either + # discarded (for <,> and :) or added to either the $field, $length + # or $content variable. + # This is a typical ADIF line and the modes in which we are while + # parsing it: + # + # DL1AA 20050401 ... + #01111122333333011111223333333330... + + # If the character is a "<" AND we are in mode 0, it means a new + # field definition starts. It's important to check that we are + # actually in the mode 0 because otherwise a "<" in a comment field + # would be mistaken for the start of a new field. + if (($ch eq "<") && ($am == 0)) { # new field starts + $field = ""; # delete old field + $len=""; # delete old length + $am = 1; # adifmode = 1 = read field + } + # The field name is read. Only allowed characters are letters and + # underscores. The read character is added to the field-name + elsif (($ch =~ /[A-Za-z_]/) && ($am == 1)) { # read field name + $field .= $ch; + } + # When we are reading the field definition (am = 1) and a colon + # occurs, it marks the end of the field def and after it the length + # starts. so we switch to am=2, which is the length mode + elsif (($ch eq ":") && ($am == 1)) { # field over, now length + $am = 2; # ==> mode 2 + } + # we are in length-mode, and add every number that comes our way to + # the $len variable. + elsif (($ch =~ /\d/) && ($am == 2)) { # read length; + $len .= $ch; # add length + } + # we are in length mode and a ">" comes our way, meaning that we + # have to start reading the content of the field from now on. so + # switch to mode 3, except when field length is zero. then $am + # becomes 0 (look for next field to start). + elsif (($ch eq ">") && ($am == 2)) { # length over + if ($len eq '0') { $am = 0; next } # no length -> read next + $am = 3; # read field content + } + # last check: we are in mode to read content + # within this check we also check if the maximum length has been + # reaced, if so, we save the information into an array of hashes. + + elsif (($am == 3) && ((length($content)) < $len)) { + $content .= $ch; + if (length($content) == $len) { + $am = 0; # field / value pair is done + # print "$nr: >$field< ---> >$content<\n"; + $qh->{"\L$field"} = $content; # fieldname lowercase + $field=""; + $content=""; + } + } # main $ch-processing ends here + } # while loop to iterate through $fullline ends here + push @qso, $qh; # add ref to qso-hash to @qso array. + addstr($win,0,50, $parsecount." "x80) unless ($parsecount % 100); + refresh($win) unless ($parsecount % 100); + $parsecount++; + } # else -> fullline complete ends here } # main loop of reading from ADIF close ADIF; @@ -3337,370 +3337,370 @@ refresh($win); # An additional key "valid" is added to the QSO hash. It is set to '1' by # default, and can be set to '0' when one of the neccessary values is invalid. -for my $i ( 0 .. $#qso ) { # iterate through Array of Hashes - $qso[$i]{'valid'} = '1'; # this QSO is now valid - $errmsg = ''; - - my @dxcc = &dxcc($qso[$i]{'call'}); - - # Now check if the minimum neccessary fields are existing... - # These are CALL, QSO_DATE, TIME_ON, BAND or FREQ, and MODE. - # Actually the ADIF specs don't specify this, but everything with less - # information than this doesn't make any sense to me. - if (exists($qso[$i]{'call'}) && exists($qso[$i]{'qso_date'}) && - exists($qso[$i]{'time_on'}) && (exists($qso[$i]{'band'}) || - exists($qso[$i]{'freq'})) && exists($qso[$i]{'mode'})) { - # minimum needed fields are existing, go on... - - # Now check the key/value pairs for compatibility with the database - # format used by YFKlog and change if needed - - - # The CALL and MODE should always be uppercase.. - - $qso[$i]{'call'} = "\U$qso[$i]{'call'}"; - $qso[$i]{'call'} =~ s/[^A-Z0-9\/]//g; # remove rubbish - $qso[$i]{'mode'} = "\U$qso[$i]{'mode'}"; - - # Anything left? - unless ($qso[$i]{"call"}=~ /^[A-Z0-9\/]{3,}$/) { - - $qso[$i]{'valid'} = '0'; - $errmsg .= "callsign invalid, "; - } - - # change the qso_date field to the proper format YYYY-MM-DD - # from the current YYYYMMDD - - # The date is REQUIRED, so do a crude check if its valid - unless ($qso[$i]{"qso_date"}=~ /^\d{8,8}$/) { - $qso[$i]{'valid'} = '0'; - $errmsg .= "date invalid, "; - } - - $qso[$i]{"qso_date"} = substr($qso[$i]{"qso_date"},0,4).'-'. - substr($qso[$i]{"qso_date"},4,2).'-'. - substr($qso[$i]{"qso_date"},6,2); - - # rename it to DATE - - $qso[$i]{"date"} = $qso[$i]{"qso_date"}; - delete($qso[$i]{"qso_date"}); - - # The time format can either be HHMM or HHMMSS. Both have to be - # converted to HH:MM:SS, for both time_on and time_off. - - # Crude check if time is valid (4 or 6 digits) - unless ($qso[$i]{"time_on"} =~ /^\d{4,6}$/) { - $qso[$i]{'valid'} = '0'; - $errmsg .= "time_on invalid, "; - } - - if (length($qso[$i]{"time_on"}) == 4) { # we have HHMM => HH:MM:00 - $qso[$i]{"time_on"} = substr($qso[$i]{"time_on"},0,2).':'. - substr($qso[$i]{"time_on"},2,2).':00'; - } - elsif (length($qso[$i]{"time_on"}) == 6) { # HHMMSS > HH:MM:SS - $qso[$i]{"time_on"} = substr($qso[$i]{"time_on"},0,2).':'. - substr($qso[$i]{"time_on"},2,2).':'. - substr($qso[$i]{"time_on"},4,2); - } - # finally rename it to t_on - $qso[$i]{"t_on"} = $qso[$i]{"time_on"}; - delete($qso[$i]{"time_on"}); - - # exactly the same for time_off, if defined: - if (defined($qso[$i]{"time_off"})) { - unless ($qso[$i]{"time_off"} =~ /^\d{4,6}$/) { - $qso[$i]{'valid'} = '0'; - $errmsg .= "time_off invalid, "; - } - - if (length($qso[$i]{"time_off"}) == 4) { # we have HHMM => HH:MM:00 - $qso[$i]{"time_off"} = substr($qso[$i]{"time_off"},0,2).':'. - substr($qso[$i]{"time_off"},2,2).':00'; - } - elsif (length($qso[$i]{"time_off"}) == 6) { # HHMMSS > HH:MM:SS - $qso[$i]{"time_off"} = substr($qso[$i]{"time_off"},0,2).':'. - substr($qso[$i]{"time_off"},2,2).':'. - substr($qso[$i]{"time_off"},4,2); - } - $qso[$i]{"t_off"} = $qso[$i]{"time_off"}; - delete($qso[$i]{"time_off"}); - } # if defined(time off) - else { # time_off is not defined, so make it the same as time_on - $qso[$i]{'t_off'} = $qso[$i]{'t_on'} - } - - # Now check if there is band info. if so, but the M or CM at the end - # and delete - if available - the 'freq' key. we only need one of them. - - if (defined($qso[$i]{"band"})) { # band info - - # Crude check if band is valid (1 .. 4 digits + (c)m,(C)M) - unless($qso[$i]{"band"}=~/^[0-9.]{1,7}(c|C)?(m|M)$/) { - $qso[$i]{'valid'}='0'; - $errmsg .= "band invalid, "; - } - - if ($qso[$i]{"band"} =~ /\d[Mm]$/) { # actually ends with m/M? - substr($qso[$i]{"band"},-1,) = ''; # cut it - } - else { # must be CM - substr($qso[$i]{"band"},-2,) = ''; # cut it - $qso[$i]{"band"} /=100; # divide to m - } - # now we have a band; if there is a frequency, delete it. - if (defined($qso[$i]{'freq'})) { - delete $qso[$i]{'freq'}; - } - if (defined($qso[$i]{'freq_rx'})) { - delete $qso[$i]{'freq_rx'}; - } - } - - # if there is a frequency tag instead of band, the band has to be - # determined from it. This works for 160m to 76GHz - if (defined($qso[$i]{'freq'})) { - - my $val = $qso[$i]{'freq'}; # save freq temporarily - - if ($val =~ /^(1[.][89]|2[.]0)/) { $qso[$i]{'band'} = '160' } - elsif ($val =~ /^[34][.]/) { $qso[$i]{'band'} = '80' } - elsif ($val =~ /(^7[.])|(^7$)/) { $qso[$i]{'band'} = '40' } - elsif ($val =~ /(^10[.](0|1))|(^10$)/) { $qso[$i]{'band'} = '30' } - elsif ($val =~ /(^14[.])|(^14$)/) { $qso[$i]{'band'} = '20' } - elsif ($val =~ /^18/) { $qso[$i]{'band'} = '17' } - elsif ($val =~ /(^21[.])|(^21$)/) { $qso[$i]{'band'} = '15' } - elsif ($val =~ /^24/) { $qso[$i]{'band'} = '12' } - elsif ($val =~ /^2(8|9)/) { $qso[$i]{'band'} = '10' } - elsif ($val =~ /^5[0-4]/) { $qso[$i]{'band'} = '6' } - elsif ($val =~ /^14[4-8]/) { $qso[$i]{'band'} = '2' } - elsif ($val =~ /^4[2-5]\d/) { $qso[$i]{'band'} = '0.7' } - elsif ($val =~ /^1[23]\d\d/) { $qso[$i]{'band'} = '0.23' } - elsif ($val =~ /^2[43]\d\d/) { $qso[$i]{'band'} = '0.13' } - elsif ($val =~ /^3\d\d\d/) { $qso[$i]{'band'} = '0.09' } - elsif ($val =~ /^5\d\d\d/) { $qso[$i]{'band'} = '0.06' } - elsif ($val =~ /^10\d\d\d/) { $qso[$i]{'band'} = '0.03' } - elsif ($val =~ /^24\d\d\d/) { $qso[$i]{'band'} = '0.0125' } - elsif ($val =~ /^47\d\d\d/) { $qso[$i]{'band'} = '0.006' } - elsif ($val =~ /^76\d\d\d/) { $qso[$i]{'band'} = '0.004' } - else { # unknown band ... - $qso[$i]{'valid'} = '0'; - $errmsg = "freq invalid, "; - } - - delete $qso[$i]{'freq'}; # don't need it anymore - if (defined($qso[$i]{'freq_rx'})) { - delete $qso[$i]{'freq_rx'}; - } - } - - # RST_RCVD and RST_SENT will be renamed to rstr and rsts - - if (defined($qso[$i]{'rst_sent'})) { - $qso[$i]{'rsts'} = $qso[$i]{'rst_sent'}; - $qso[$i]{'rsts'} =~ s/[^0-9]//g; - delete($qso[$i]{'rst_sent'}); - } - - if (defined($qso[$i]{'rst_rcvd'})) { - $qso[$i]{'rstr'} = $qso[$i]{'rst_rcvd'}; - $qso[$i]{'rstr'} =~ s/[^0-9]//g; - delete($qso[$i]{'rst_rcvd'}); - } - - # Check if a prefix was defined in the adif-file. If not, get it from - # the &wpx sub. - unless(defined($qso[$i]{'pfx'})) { - $qso[$i]{'pfx'} = &wpx($qso[$i]{'call'}); - # Sanity check: May be undef - unless (defined($qso[$i]{'pfx'})) { - $war++; - print ERROR "Warning: Can't determine prefix of ". - "$qso[$i]{call}\n"; - $qso[$i]{'pfx'} = ''; - } - } - - # received serial number will be added to the RST field if it - # exists. If not, create RST field with only serial number in it - if (defined($qso[$i]{'srx'})) { - - if (defined($qso[$i]{'rstr'})) { # rst-rcvd exists - $qso[$i]{'rstr'} .= $qso[$i]{'srx'}; # add it - } - else { # doesnt exist! - $qso[$i]{'rstr'} = $qso[$i]{'srx'}; # create it - } - delete($qso[$i]{'srx'}); # delete key/value pair - } - - # same for sent serial number - - if (defined($qso[$i]{'stx'})) { - - if (defined($qso[$i]{'rsts'})) { - $qso[$i]{'rsts'} .= $qso[$i]{'stx'}; - } - else { - $qso[$i]{'rsts'} = $qso[$i]{'stx'}; - } - delete($qso[$i]{'stx'}); # delete key/value pair - } - - # there is no contest_id field in YFKlog, it is saved in the remarks - # field, if available - if (defined($qso[$i]{"contest_id"})) { - unless (defined($qso[$i]{'rem'})) { # nothing in REM yet - $qso[$i]{'rem'} = $qso[$i]{'contest_id'}; # put it in there - } - else { # remarks field exists - $qso[$i]{'rem'} .= " ".$qso[$i]{'contest_id'}; - } - delete($qso[$i]{'contest_id'}); # delete contest_id - } - - # Rename GRIDSQUARE to GRID if it looks valid. - - if (defined($qso[$i]{"gridsquare"})) { - if ($qso[$i]{"gridsquare"} =~ /^[A-Z]{2}[0-9]{2}/) { - $qso[$i]{"grid"} = "\U$qso[$i]{'gridsquare'}"; - delete($qso[$i]{'gridsquare'}); - } - } - - # Comments go into the value for key 'rem'. Note that it might already - # have a value by contest_id or gridsquare! - if (defined($qso[$i]{"comment"})) { - unless (defined($qso[$i]{'rem'})) { # nothing in REM yet - $qso[$i]{'rem'} = $qso[$i]{'comment'}; # put it in there - } - else { # remarks field exists - $qso[$i]{'rem'} .= " ".$qso[$i]{'comment'}; - } - delete($qso[$i]{'comment'}); # delete comment field - - if (length($qso[$i]{'rem'}) > 60) { - $qso[$i]{rem} = substr($qso[$i]{rem}, 0, 60); - } - - } - - # QSL_VIA information from ADIF goes straight into the QSLINFO field - if (defined($qso[$i]{"qsl_via"})) { - $qso[$i]{'qslinfo'} = $qso[$i]{"qsl_via"}; - delete($qso[$i]{"qsl_via"}); - } - - # Cut Name and QTH if too long. - if (defined($qso[$i]{name})) { - if (length($qso[$i]{name}) > 15) { - $qso[$i]{name} = substr($qso[$i]{name}, 0, 15); - } - } - - if (defined($qso[$i]{qth})) { - if (length($qso[$i]{qth}) > 15) { - $qso[$i]{qth} = substr($qso[$i]{qth}, 0, 15); - } - } - - # TX_PWR from ADIF goes into the PWR field. Since some logbook programs - # add a "W" (which is agains the adif specs), remove it if neccessary. - if (defined($qso[$i]{tx_pwr})) { - $qso[$i]{pwr} = $qso[$i]{tx_pwr}; - $qso[$i]{pwr} =~ s/[^0-9]//g; - delete($qso[$i]{tx_pwr}); - } - else { # no pwr specified in ADIF - $qso[$i]{pwr} = $dpwr; # default power from config file - } - - - # The DXCC information is not neccessarily included in the ADIF file. - # It consists of a number, NOT neccessarily following the ARRL - # conventions, so the corresponding ARRL DXCC has to be fetched from an - # external database (TBD). - - # if (defined($qso[$i]{'dxcc'})) { - # TBD DXCC lookup in ADIF<->ARRL DB - # - #} - # If no DXCC is given, we try to derive it from the call by the - # &dxcc() function. Note that this *might* be wrong, that's why we try - # to use the value from the ADIF file first - #else { - # FIXME FIXME FIXME FIXME FIXME FIXME - # DXCC info is always taken from cty.dat - # FIXME FIXME FIXME FIXME FIXME FIXME - - $qso[$i]{'dxcc'} = $dxcc[7]; - $qso[$i]{'cont'} = $dxcc[3]; - #} - - # Add CONT if not already done - unless (defined($qso[$i]{'cont'})) { - $qso[$i]{'cont'} = $dxcc[3]; - } - - # Add ITUZ if not already done - unless (defined($qso[$i]{'ituz'})) { - $qso[$i]{'ituz'} = $dxcc[2]; - } - - # Add CQZ if not already done - unless (defined($qso[$i]{'cqz'})) { - $qso[$i]{'cqz'} = $dxcc[1]; - } - - # check if QSL_SENT exists. If so, take it, if not use default $dqslsi - if (defined($qso[$i]{'qsl_sent'})) { - $qso[$i]{'qsls'} = $qso[$i]{'qsl_sent'}; - delete($qso[$i]{'qsl_sent'}); - } - else { # no qsl-sent, so use $dqslsi - $qso[$i]{'qsls'} = $dqslsi; - } - # check if QSL_RCVD exists. If so, take it, if not use "N" - if (defined($qso[$i]{'qsl_rcvd'})) { - $qso[$i]{'qslr'} = $qso[$i]{'qsl_rcvd'}; - delete($qso[$i]{'qsl_rcvd'}); - } - else { # no qsl-rcvd, set to "N" - $qso[$i]{'qslr'} = "N"; - } - - # made all neccessary changes to the QSO hash - - } # if (exists $neccessary data) ... - else { # the QSO is NOT VALID! - $qso[$i]{'valid'} = '0'; # set QSO invalid - $errmsg .= "Basic info missing: Call, Date, Time_on, Band or Freq and Mode. "; - } - - # At this point we have either processed the hash in a way that it can be - # imported (when the value for key 'valid' is 1), or the QSO is not valid - # If the QSO is valid, we are happy and go on. otherwise the content of the - # invalid QSO-hash is written to the error-log, so the user knows what went - # wrong. - - if ($qso[$i]{'valid'} eq '0') { # invalid QSO! - $err++; # count up error number - print ERROR "ERROR: QSO Nr $i was invalid:\n"; - for my $key (sort keys %{$qso[$i]}) { # iterate through hash keys - print ERROR "'$key' ==> '$qso[$i]{$key}', "; # value - } - print ERROR "\nPossible Reason: $errmsg \n"; - print ERROR "\nTHIS QSO WAS NOT IMPORTED! \n\n"; - } - - # After every 100 QSOs give a little status output - - addstr($win,0,0, "Errors: $err, now importing QSO: ".($i+1).", $qso[$i]{'call'}"." "x80); - refresh($win) unless (($i+1) % 100); - - +for my $i ( 0 .. $#qso ) { # iterate through Array of Hashes + $qso[$i]{'valid'} = '1'; # this QSO is now valid + $errmsg = ''; + + my @dxcc = &dxcc($qso[$i]{'call'}); + + # Now check if the minimum neccessary fields are existing... + # These are CALL, QSO_DATE, TIME_ON, BAND or FREQ, and MODE. + # Actually the ADIF specs don't specify this, but everything with less + # information than this doesn't make any sense to me. + if (exists($qso[$i]{'call'}) && exists($qso[$i]{'qso_date'}) && + exists($qso[$i]{'time_on'}) && (exists($qso[$i]{'band'}) || + exists($qso[$i]{'freq'})) && exists($qso[$i]{'mode'})) { + # minimum needed fields are existing, go on... + + # Now check the key/value pairs for compatibility with the database + # format used by YFKlog and change if needed + + + # The CALL and MODE should always be uppercase.. + + $qso[$i]{'call'} = "\U$qso[$i]{'call'}"; + $qso[$i]{'call'} =~ s/[^A-Z0-9\/]//g; # remove rubbish + $qso[$i]{'mode'} = "\U$qso[$i]{'mode'}"; + + # Anything left? + unless ($qso[$i]{"call"}=~ /^[A-Z0-9\/]{3,}$/) { + + $qso[$i]{'valid'} = '0'; + $errmsg .= "callsign invalid, "; + } + + # change the qso_date field to the proper format YYYY-MM-DD + # from the current YYYYMMDD + + # The date is REQUIRED, so do a crude check if its valid + unless ($qso[$i]{"qso_date"}=~ /^\d{8,8}$/) { + $qso[$i]{'valid'} = '0'; + $errmsg .= "date invalid, "; + } + + $qso[$i]{"qso_date"} = substr($qso[$i]{"qso_date"},0,4).'-'. + substr($qso[$i]{"qso_date"},4,2).'-'. + substr($qso[$i]{"qso_date"},6,2); + + # rename it to DATE + + $qso[$i]{"date"} = $qso[$i]{"qso_date"}; + delete($qso[$i]{"qso_date"}); + + # The time format can either be HHMM or HHMMSS. Both have to be + # converted to HH:MM:SS, for both time_on and time_off. + + # Crude check if time is valid (4 or 6 digits) + unless ($qso[$i]{"time_on"} =~ /^\d{4,6}$/) { + $qso[$i]{'valid'} = '0'; + $errmsg .= "time_on invalid, "; + } + + if (length($qso[$i]{"time_on"}) == 4) { # we have HHMM => HH:MM:00 + $qso[$i]{"time_on"} = substr($qso[$i]{"time_on"},0,2).':'. + substr($qso[$i]{"time_on"},2,2).':00'; + } + elsif (length($qso[$i]{"time_on"}) == 6) { # HHMMSS > HH:MM:SS + $qso[$i]{"time_on"} = substr($qso[$i]{"time_on"},0,2).':'. + substr($qso[$i]{"time_on"},2,2).':'. + substr($qso[$i]{"time_on"},4,2); + } + # finally rename it to t_on + $qso[$i]{"t_on"} = $qso[$i]{"time_on"}; + delete($qso[$i]{"time_on"}); + + # exactly the same for time_off, if defined: + if (defined($qso[$i]{"time_off"})) { + unless ($qso[$i]{"time_off"} =~ /^\d{4,6}$/) { + $qso[$i]{'valid'} = '0'; + $errmsg .= "time_off invalid, "; + } + + if (length($qso[$i]{"time_off"}) == 4) { # we have HHMM => HH:MM:00 + $qso[$i]{"time_off"} = substr($qso[$i]{"time_off"},0,2).':'. + substr($qso[$i]{"time_off"},2,2).':00'; + } + elsif (length($qso[$i]{"time_off"}) == 6) { # HHMMSS > HH:MM:SS + $qso[$i]{"time_off"} = substr($qso[$i]{"time_off"},0,2).':'. + substr($qso[$i]{"time_off"},2,2).':'. + substr($qso[$i]{"time_off"},4,2); + } + $qso[$i]{"t_off"} = $qso[$i]{"time_off"}; + delete($qso[$i]{"time_off"}); + } # if defined(time off) + else { # time_off is not defined, so make it the same as time_on + $qso[$i]{'t_off'} = $qso[$i]{'t_on'} + } + + # Now check if there is band info. if so, but the M or CM at the end + # and delete - if available - the 'freq' key. we only need one of them. + + if (defined($qso[$i]{"band"})) { # band info + + # Crude check if band is valid (1 .. 4 digits + (c)m,(C)M) + unless($qso[$i]{"band"}=~/^[0-9.]{1,7}(c|C)?(m|M)$/) { + $qso[$i]{'valid'}='0'; + $errmsg .= "band invalid, "; + } + + if ($qso[$i]{"band"} =~ /\d[Mm]$/) { # actually ends with m/M? + substr($qso[$i]{"band"},-1,) = ''; # cut it + } + else { # must be CM + substr($qso[$i]{"band"},-2,) = ''; # cut it + $qso[$i]{"band"} /=100; # divide to m + } + # now we have a band; if there is a frequency, delete it. + if (defined($qso[$i]{'freq'})) { + delete $qso[$i]{'freq'}; + } + if (defined($qso[$i]{'freq_rx'})) { + delete $qso[$i]{'freq_rx'}; + } + } + + # if there is a frequency tag instead of band, the band has to be + # determined from it. This works for 160m to 76GHz + if (defined($qso[$i]{'freq'})) { + + my $val = $qso[$i]{'freq'}; # save freq temporarily + + if ($val =~ /^(1[.][89]|2[.]0)/) { $qso[$i]{'band'} = '160' } + elsif ($val =~ /^[34][.]/) { $qso[$i]{'band'} = '80' } + elsif ($val =~ /(^7[.])|(^7$)/) { $qso[$i]{'band'} = '40' } + elsif ($val =~ /(^10[.](0|1))|(^10$)/) { $qso[$i]{'band'} = '30' } + elsif ($val =~ /(^14[.])|(^14$)/) { $qso[$i]{'band'} = '20' } + elsif ($val =~ /^18/) { $qso[$i]{'band'} = '17' } + elsif ($val =~ /(^21[.])|(^21$)/) { $qso[$i]{'band'} = '15' } + elsif ($val =~ /^24/) { $qso[$i]{'band'} = '12' } + elsif ($val =~ /^2(8|9)/) { $qso[$i]{'band'} = '10' } + elsif ($val =~ /^5[0-4]/) { $qso[$i]{'band'} = '6' } + elsif ($val =~ /^14[4-8]/) { $qso[$i]{'band'} = '2' } + elsif ($val =~ /^4[2-5]\d/) { $qso[$i]{'band'} = '0.7' } + elsif ($val =~ /^1[23]\d\d/) { $qso[$i]{'band'} = '0.23' } + elsif ($val =~ /^2[43]\d\d/) { $qso[$i]{'band'} = '0.13' } + elsif ($val =~ /^3\d\d\d/) { $qso[$i]{'band'} = '0.09' } + elsif ($val =~ /^5\d\d\d/) { $qso[$i]{'band'} = '0.06' } + elsif ($val =~ /^10\d\d\d/) { $qso[$i]{'band'} = '0.03' } + elsif ($val =~ /^24\d\d\d/) { $qso[$i]{'band'} = '0.0125' } + elsif ($val =~ /^47\d\d\d/) { $qso[$i]{'band'} = '0.006' } + elsif ($val =~ /^76\d\d\d/) { $qso[$i]{'band'} = '0.004' } + else { # unknown band ... + $qso[$i]{'valid'} = '0'; + $errmsg = "freq invalid, "; + } + + delete $qso[$i]{'freq'}; # don't need it anymore + if (defined($qso[$i]{'freq_rx'})) { + delete $qso[$i]{'freq_rx'}; + } + } + + # RST_RCVD and RST_SENT will be renamed to rstr and rsts + + if (defined($qso[$i]{'rst_sent'})) { + $qso[$i]{'rsts'} = $qso[$i]{'rst_sent'}; + $qso[$i]{'rsts'} =~ s/[^0-9]//g; + delete($qso[$i]{'rst_sent'}); + } + + if (defined($qso[$i]{'rst_rcvd'})) { + $qso[$i]{'rstr'} = $qso[$i]{'rst_rcvd'}; + $qso[$i]{'rstr'} =~ s/[^0-9]//g; + delete($qso[$i]{'rst_rcvd'}); + } + + # Check if a prefix was defined in the adif-file. If not, get it from + # the &wpx sub. + unless(defined($qso[$i]{'pfx'})) { + $qso[$i]{'pfx'} = &wpx($qso[$i]{'call'}); + # Sanity check: May be undef + unless (defined($qso[$i]{'pfx'})) { + $war++; + print ERROR "Warning: Can't determine prefix of ". + "$qso[$i]{call}\n"; + $qso[$i]{'pfx'} = ''; + } + } + + # received serial number will be added to the RST field if it + # exists. If not, create RST field with only serial number in it + if (defined($qso[$i]{'srx'})) { + + if (defined($qso[$i]{'rstr'})) { # rst-rcvd exists + $qso[$i]{'rstr'} .= $qso[$i]{'srx'}; # add it + } + else { # doesnt exist! + $qso[$i]{'rstr'} = $qso[$i]{'srx'}; # create it + } + delete($qso[$i]{'srx'}); # delete key/value pair + } + + # same for sent serial number + + if (defined($qso[$i]{'stx'})) { + + if (defined($qso[$i]{'rsts'})) { + $qso[$i]{'rsts'} .= $qso[$i]{'stx'}; + } + else { + $qso[$i]{'rsts'} = $qso[$i]{'stx'}; + } + delete($qso[$i]{'stx'}); # delete key/value pair + } + + # there is no contest_id field in YFKlog, it is saved in the remarks + # field, if available + if (defined($qso[$i]{"contest_id"})) { + unless (defined($qso[$i]{'rem'})) { # nothing in REM yet + $qso[$i]{'rem'} = $qso[$i]{'contest_id'}; # put it in there + } + else { # remarks field exists + $qso[$i]{'rem'} .= " ".$qso[$i]{'contest_id'}; + } + delete($qso[$i]{'contest_id'}); # delete contest_id + } + + # Rename GRIDSQUARE to GRID if it looks valid. + + if (defined($qso[$i]{"gridsquare"})) { + if ($qso[$i]{"gridsquare"} =~ /^[A-Z]{2}[0-9]{2}/) { + $qso[$i]{"grid"} = "\U$qso[$i]{'gridsquare'}"; + delete($qso[$i]{'gridsquare'}); + } + } + + # Comments go into the value for key 'rem'. Note that it might already + # have a value by contest_id or gridsquare! + if (defined($qso[$i]{"comment"})) { + unless (defined($qso[$i]{'rem'})) { # nothing in REM yet + $qso[$i]{'rem'} = $qso[$i]{'comment'}; # put it in there + } + else { # remarks field exists + $qso[$i]{'rem'} .= " ".$qso[$i]{'comment'}; + } + delete($qso[$i]{'comment'}); # delete comment field + + if (length($qso[$i]{'rem'}) > 60) { + $qso[$i]{rem} = substr($qso[$i]{rem}, 0, 60); + } + + } + + # QSL_VIA information from ADIF goes straight into the QSLINFO field + if (defined($qso[$i]{"qsl_via"})) { + $qso[$i]{'qslinfo'} = $qso[$i]{"qsl_via"}; + delete($qso[$i]{"qsl_via"}); + } + + # Cut Name and QTH if too long. + if (defined($qso[$i]{name})) { + if (length($qso[$i]{name}) > 15) { + $qso[$i]{name} = substr($qso[$i]{name}, 0, 15); + } + } + + if (defined($qso[$i]{qth})) { + if (length($qso[$i]{qth}) > 15) { + $qso[$i]{qth} = substr($qso[$i]{qth}, 0, 15); + } + } + + # TX_PWR from ADIF goes into the PWR field. Since some logbook programs + # add a "W" (which is agains the adif specs), remove it if neccessary. + if (defined($qso[$i]{tx_pwr})) { + $qso[$i]{pwr} = $qso[$i]{tx_pwr}; + $qso[$i]{pwr} =~ s/[^0-9]//g; + delete($qso[$i]{tx_pwr}); + } + else { # no pwr specified in ADIF + $qso[$i]{pwr} = $dpwr; # default power from config file + } + + + # The DXCC information is not neccessarily included in the ADIF file. + # It consists of a number, NOT neccessarily following the ARRL + # conventions, so the corresponding ARRL DXCC has to be fetched from an + # external database (TBD). + + # if (defined($qso[$i]{'dxcc'})) { + # TBD DXCC lookup in ADIF<->ARRL DB + # + #} + # If no DXCC is given, we try to derive it from the call by the + # &dxcc() function. Note that this *might* be wrong, that's why we try + # to use the value from the ADIF file first + #else { + # FIXME FIXME FIXME FIXME FIXME FIXME + # DXCC info is always taken from cty.dat + # FIXME FIXME FIXME FIXME FIXME FIXME + + $qso[$i]{'dxcc'} = $dxcc[7]; + $qso[$i]{'cont'} = $dxcc[3]; + #} + + # Add CONT if not already done + unless (defined($qso[$i]{'cont'})) { + $qso[$i]{'cont'} = $dxcc[3]; + } + + # Add ITUZ if not already done + unless (defined($qso[$i]{'ituz'})) { + $qso[$i]{'ituz'} = $dxcc[2]; + } + + # Add CQZ if not already done + unless (defined($qso[$i]{'cqz'})) { + $qso[$i]{'cqz'} = $dxcc[1]; + } + + # check if QSL_SENT exists. If so, take it, if not use default $dqslsi + if (defined($qso[$i]{'qsl_sent'})) { + $qso[$i]{'qsls'} = $qso[$i]{'qsl_sent'}; + delete($qso[$i]{'qsl_sent'}); + } + else { # no qsl-sent, so use $dqslsi + $qso[$i]{'qsls'} = $dqslsi; + } + # check if QSL_RCVD exists. If so, take it, if not use "N" + if (defined($qso[$i]{'qsl_rcvd'})) { + $qso[$i]{'qslr'} = $qso[$i]{'qsl_rcvd'}; + delete($qso[$i]{'qsl_rcvd'}); + } + else { # no qsl-rcvd, set to "N" + $qso[$i]{'qslr'} = "N"; + } + + # made all neccessary changes to the QSO hash + + } # if (exists $neccessary data) ... + else { # the QSO is NOT VALID! + $qso[$i]{'valid'} = '0'; # set QSO invalid + $errmsg .= "Basic info missing: Call, Date, Time_on, Band or Freq and Mode. "; + } + + # At this point we have either processed the hash in a way that it can be + # imported (when the value for key 'valid' is 1), or the QSO is not valid + # If the QSO is valid, we are happy and go on. otherwise the content of the + # invalid QSO-hash is written to the error-log, so the user knows what went + # wrong. + + if ($qso[$i]{'valid'} eq '0') { # invalid QSO! + $err++; # count up error number + print ERROR "ERROR: QSO Nr $i was invalid:\n"; + for my $key (sort keys %{$qso[$i]}) { # iterate through hash keys + print ERROR "'$key' ==> '$qso[$i]{$key}', "; # value + } + print ERROR "\nPossible Reason: $errmsg \n"; + print ERROR "\nTHIS QSO WAS NOT IMPORTED! \n\n"; + } + + # After every 100 QSOs give a little status output + + addstr($win,0,0, "Errors: $err, now importing QSO: ".($i+1).", $qso[$i]{'call'}"." "x80); + refresh($win) unless (($i+1) % 100); + + } # iterate through AoH, arrives here after every QSO was processed. addstr($win,0,0, "All QSOs processed, now adding QSOs to database..."); @@ -3715,101 +3715,101 @@ refresh($win); # database is generated. my %fields = ('call' => 1, 'date' => 1, 't_on' => 1, 't_off' => 1, - 'band' => 1, 'mode' => 1, 'qth' => 1, 'name' => 1, - 'rstr' => 1, 'rsts' => 1, 'operator' => 1, 'grid'=> 1, - 'qsls' => 1, 'qslr' => 1, 'rem' => 1, 'pwr' => 1, - 'dxcc' => 1, 'pfx' => 1, 'cqz' => 1, 'cont' => 1, - 'ituz' => 1, 'qslinfo' => 1, 'iota' => 1, 'state' => 1); - -for my $i (0 .. $#qso) { # iterate through Array of Hashes - my $sql; # sql-string part one - my $sqlvalues; # part two - - if ($qso[$i]{'valid'} eq '0') { next; } # invalid QSO, don't export! - delete($qso[$i]{'valid'}); # validity info not needed anymore - - # NB: As of 0.3.0, the SQL string looks like: - # INSERT INTO log_dj1yfk (call, date, ...) VALUES ('DJ1YFK', - # '2001-01-01'... ) since SQLite doesn't support the SET x=y syntax. - - $sql= "INSERT INTO log_$mycall ("; # start buildung SQL string - $sqlvalues = ") VALUES ("; - - # Now iterate through hash keys. if its valid, i.e. contained in the - # %fields hash, it will be added to the SQL string, otherwise written to - # the error-log. If a ' appears in any field, it has to be escaped. - for my $key (keys %{$qso[$i]}) { - if (defined($fields{$key})) { # if field is valid - $qso[$i]{$key} = $dbh->quote($qso[$i]{$key}); - $sql .= "`$key`,"; - $sqlvalues .= "$qso[$i]{$key}, "; # add key-value pair to DB - } - else { # invalid field. - $war++; - print ERROR "WARNING: In QSO $i unknown field: $key =>". - " $qso[$i]{$key} IGNORED!\n"; - print ERROR "CALL: $qso[$i]{'call'} DATE: $qso[$i]{'date'}, BAND:". - "$qso[$i]{'band'}, TIME: $qso[$i]{'t_on'}\n\n"; - } - } - - $sql =~ s/,$//; - $sqlvalues =~ s/, $/);/; - - $sql .= $sqlvalues; - - # MySQL5 doesn't like CALL, so change it to `CALL` - - $sql =~ s/call=/`CALL`=/gi; - - # Now put the QSO into the database: - $dbh->do($sql) or die "Insert QSO $sql failed!"; - - # Check if the Name and QTH of the callsign is already known in the CALLS - # table. If not, use Name and QTH from the ADI-file if it exists. Crop all - # unneccessary stuff from the call (/P etc). - - if (defined($qso[$i]{'name'}) || defined($qso[$i]{'qth'})) { - my $call = $qso[$i]{'call'}; # The call to crop - - $call =~ s/[^A-Z0-9\/]//g; # remove quotes, if any - - # Split the call at every /, chose longest part. Might go wrong - # in very rare cases (KH7K/K1A), but I don't care :-) - - if ($call =~ /\//) { # dahditditdahdit in call - my @call = split(/\//, $call); - my $length=0; # length of splitted part - foreach(@call) { # chose longest part - if (length($_) >= $length) { - $length = length($_); - $call = $_; - } - } - } - - my $sth = $dbh->prepare("SELECT `CALL` FROM `calls` WHERE - `CALL`='$call';"); - $sth->execute(); - unless ($sth->fetch()) { # nothing to fetch -> call is unknown! - # Add information from ADIF to the database, if QTH/Name is now - # know, just a empty field. - unless (defined($qso[$i]{'name'})) {$qso[$i]{'name'}="''";} - unless (defined($qso[$i]{'qth'})) {$qso[$i]{'qth'}="''";} - $dbh->do("INSERT INTO calls (`CALL`, `NAME`, `QTH`) VALUES - ('$call',$qso[$i]{'name'},$qso[$i]{'qth'});"); - } - } - + 'band' => 1, 'mode' => 1, 'qth' => 1, 'name' => 1, + 'rstr' => 1, 'rsts' => 1, 'operator' => 1, 'grid'=> 1, + 'qsls' => 1, 'qslr' => 1, 'rem' => 1, 'pwr' => 1, + 'dxcc' => 1, 'pfx' => 1, 'cqz' => 1, 'cont' => 1, + 'ituz' => 1, 'qslinfo' => 1, 'iota' => 1, 'state' => 1); + +for my $i (0 .. $#qso) { # iterate through Array of Hashes + my $sql; # sql-string part one + my $sqlvalues; # part two + + if ($qso[$i]{'valid'} eq '0') { next; } # invalid QSO, don't export! + delete($qso[$i]{'valid'}); # validity info not needed anymore + + # NB: As of 0.3.0, the SQL string looks like: + # INSERT INTO log_dj1yfk (call, date, ...) VALUES ('DJ1YFK', + # '2001-01-01'... ) since SQLite doesn't support the SET x=y syntax. + + $sql= "INSERT INTO log_$mycall ("; # start buildung SQL string + $sqlvalues = ") VALUES ("; + + # Now iterate through hash keys. if its valid, i.e. contained in the + # %fields hash, it will be added to the SQL string, otherwise written to + # the error-log. If a ' appears in any field, it has to be escaped. + for my $key (keys %{$qso[$i]}) { + if (defined($fields{$key})) { # if field is valid + $qso[$i]{$key} = $dbh->quote($qso[$i]{$key}); + $sql .= "`$key`,"; + $sqlvalues .= "$qso[$i]{$key}, "; # add key-value pair to DB + } + else { # invalid field. + $war++; + print ERROR "WARNING: In QSO $i unknown field: $key =>". + " $qso[$i]{$key} IGNORED!\n"; + print ERROR "CALL: $qso[$i]{'call'} DATE: $qso[$i]{'date'}, BAND:". + "$qso[$i]{'band'}, TIME: $qso[$i]{'t_on'}\n\n"; + } + } + + $sql =~ s/,$//; + $sqlvalues =~ s/, $/);/; + + $sql .= $sqlvalues; + + # MySQL5 doesn't like CALL, so change it to `CALL` + + $sql =~ s/call=/`CALL`=/gi; + + # Now put the QSO into the database: + $dbh->do($sql) or die "Insert QSO $sql failed!"; + + # Check if the Name and QTH of the callsign is already known in the CALLS + # table. If not, use Name and QTH from the ADI-file if it exists. Crop all + # unneccessary stuff from the call (/P etc). + + if (defined($qso[$i]{'name'}) || defined($qso[$i]{'qth'})) { + my $call = $qso[$i]{'call'}; # The call to crop + + $call =~ s/[^A-Z0-9\/]//g; # remove quotes, if any + + # Split the call at every /, chose longest part. Might go wrong + # in very rare cases (KH7K/K1A), but I don't care :-) + + if ($call =~ /\//) { # dahditditdahdit in call + my @call = split(/\//, $call); + my $length=0; # length of splitted part + foreach(@call) { # chose longest part + if (length($_) >= $length) { + $length = length($_); + $call = $_; + } + } + } + + my $sth = $dbh->prepare("SELECT `CALL` FROM `calls` WHERE + `CALL`='$call';"); + $sth->execute(); + unless ($sth->fetch()) { # nothing to fetch -> call is unknown! + # Add information from ADIF to the database, if QTH/Name is now + # know, just a empty field. + unless (defined($qso[$i]{'name'})) {$qso[$i]{'name'}="''";} + unless (defined($qso[$i]{'qth'})) {$qso[$i]{'qth'}="''";} + $dbh->do("INSERT INTO calls (`CALL`, `NAME`, `QTH`) VALUES + ('$call',$qso[$i]{'name'},$qso[$i]{'qth'});"); + } + } + } -close ERROR; +close ERROR; addstr($win,0,0,"Done. Import complete. "); refresh($win); return($nr, $err, $war); - + } # end of adifimport ############################################################################## @@ -3822,25 +3822,25 @@ return($nr, $err, $war); ############################################################################## sub getlogs { - my @logs; # logs in the database - my $showtables = "SHOW TABLES"; + my @logs; # logs in the database + my $showtables = "SHOW TABLES"; - if ($db eq 'sqlite') { - $showtables = "select name from sqlite_master where type='table';" - } + if ($db eq 'sqlite') { + $showtables = "select name from sqlite_master where type='table';" + } - my $gl = $dbh->prepare($showtables); - $gl->execute(); + my $gl = $dbh->prepare($showtables); + $gl->execute(); - while(my $l = $gl->fetchrow_array()) { - if ($l =~ /^log_(.*)$/) { # a new logbook found - my $x = $1; # cannot modify $1, so save to $x - $x=~ s/_/\//g; # change underscore _ to slash / - push(@logs, "\U$x"); # add uppercase callsign to the list - } - } + while(my $l = $gl->fetchrow_array()) { + if ($l =~ /^log_(.*)$/) { # a new logbook found + my $x = $1; # cannot modify $1, so save to $x + $x=~ s/_/\//g; # change underscore _ to slash / + push(@logs, "\U$x"); # add uppercase callsign to the list + } + } - return @logs; + return @logs; } # getlogs ############################################################################## @@ -3849,7 +3849,7 @@ sub getlogs { ############################################################################## sub changemycall { - $mycall = $_[0]; + $mycall = $_[0]; } ############################################################################## @@ -3859,39 +3859,39 @@ sub changemycall { ############################################################################## sub newlogtable { - my $call = $_[0]; # callsign of the new database - - my $filename = "$prefix/share/yfklog/db_log.sql"; - if ($db eq 'sqlite') { - $filename = "$prefix/share/yfklog/db_log.sqlite"; - } - - open DB, $filename; # database definition in this file - my @db = ; # read database def. into @db - - # We assume that the callsign in $_[0] is valid, because the &askbox() - # which produced it only accepted valid callsign-letters. - # only exception: empty callsign! - - if ($call eq '') { - return "**** Invalid callsign! ****"; - } - - $call =~ tr/\//_/; # convert "/" to "_" - $call =~ tr/[A-Z]/[a-z]/; # make call lowercase - - - # Now check if there is also a table existing with the same name - - unless (&tableexists("log_$call")) { # If logbook does not yet exist, create it - my $db = "@db"; - $db =~ s/MYCALL/$call/g;# replace the callsign placeholder - $dbh->do($db); # create it! - return "Logbook successfully created!"; - } - else { # log already existed - return "Logbook with same name already exists!"; - } + my $call = $_[0]; # callsign of the new database + + my $filename = "$prefix/share/yfklog/db_log.sql"; + if ($db eq 'sqlite') { + $filename = "$prefix/share/yfklog/db_log.sqlite"; + } + + open DB, $filename; # database definition in this file + my @db = ; # read database def. into @db + + # We assume that the callsign in $_[0] is valid, because the &askbox() + # which produced it only accepted valid callsign-letters. + # only exception: empty callsign! + + if ($call eq '') { + return "**** Invalid callsign! ****"; + } + + $call =~ tr/\//_/; # convert "/" to "_" + $call =~ tr/[A-Z]/[a-z]/; # make call lowercase + + + # Now check if there is also a table existing with the same name + + unless (&tableexists("log_$call")) { # If logbook does not yet exist, create it + my $db = "@db"; + $db =~ s/MYCALL/$call/g;# replace the callsign placeholder + $dbh->do($db); # create it! + return "Logbook successfully created!"; + } + else { # log already existed + return "Logbook with same name already exists!"; + } } # newlogtable ############################################################################## @@ -3901,39 +3901,39 @@ sub newlogtable { ############################################################################## sub oldlogtable { - my $call = $_[0]; # callsign to delete - - my $filename = "$prefix/share/yfklog/db_log.sql"; - if ($db eq 'sqlite') { - $filename = "$prefix/share/yfklog/db_log.sqlite"; - } - - open DB, $filename; # database definition in this file - my @db = ; # read database def. into @db - - # We assume that the callsign in $_[0] is valid, because the &askbox() - # which produced it only accepted valid callsign-letters. - # only exception: empty callsign! - - if ($call eq '') { - return "**** Invalid callsign! ****"; - } - - $call =~ tr/\//_/; # convert "/" to "_" - $call =~ tr/[A-Z]/[a-z]/; # make call lowercase - - - # Now check if there is a table with an existing name - - if (&tableexists("log_$call")) { # If logbook does exist, delete it - my $db = "@db"; -# $db =~ s/MYCALL/$call/g;# replace the callsign placeholder - $dbh->do("DROP table log_$call"); # erase it! - return "Logbook successfully erased!"; - } - else { # log already existed - return "No logbook for this call!"; - } + my $call = $_[0]; # callsign to delete + + my $filename = "$prefix/share/yfklog/db_log.sql"; + if ($db eq 'sqlite') { + $filename = "$prefix/share/yfklog/db_log.sqlite"; + } + + open DB, $filename; # database definition in this file + my @db = ; # read database def. into @db + + # We assume that the callsign in $_[0] is valid, because the &askbox() + # which produced it only accepted valid callsign-letters. + # only exception: empty callsign! + + if ($call eq '') { + return "**** Invalid callsign! ****"; + } + + $call =~ tr/\//_/; # convert "/" to "_" + $call =~ tr/[A-Z]/[a-z]/; # make call lowercase + + + # Now check if there is a table with an existing name + + if (&tableexists("log_$call")) { # If logbook does exist, delete it + my $db = "@db"; +# $db =~ s/MYCALL/$call/g;# replace the callsign placeholder + $dbh->do("DROP table log_$call"); # erase it! + return "Logbook successfully erased!"; + } + else { # log already existed + return "No logbook for this call!"; + } } # oldlogtable ############################################################################## @@ -3943,31 +3943,31 @@ sub oldlogtable { ############################################################################## sub choseeditqso { - my $offset=0; # offset when scrolling in the list - my $aline=0; # active / highlighted line - my $ch; # character read from keyboard - my $ret; # return number - my $goon=1; # becomes 0 when we are done - my $count; # number of entries/QSOs matching - my $pos=$_[2]; # ref position in the QSOs from 1 .. $count - - my $win = ${$_[0]}; # Window where output goes. height = 17 - my $sql; # SQL string with search criteria - my $sql2=' AND 1 '; - my @qso = @{$_[1]}; # search criteria - + my $offset=0; # offset when scrolling in the list + my $aline=0; # active / highlighted line + my $ch; # character read from keyboard + my $ret; # return number + my $goon=1; # becomes 0 when we are done + my $count; # number of entries/QSOs matching + my $pos=$_[2]; # ref position in the QSOs from 1 .. $count + + my $win = ${$_[0]}; # Window where output goes. height = 17 + my $sql; # SQL string with search criteria + my $sql2=' AND 1 '; + my @qso = @{$_[1]}; # search criteria + my $nlines = $main::row - 7; # Assemble a SQL string which contains the search criteria. First the # columns which should be displayed. $sql = "SELECT `NR`, `CALL`, `NAME`, `DATE`, `T_ON`, `BAND`, `MODE`, - `QSLS`, `QSLR`, `DXCC`, `QSLINFO`, `QSLRL` FROM log_$mycall WHERE `NR` "; + `QSLS`, `QSLR`, `DXCC`, `QSLINFO`, `QSLRL` FROM log_$mycall WHERE `NR` "; # The rest of the string now depends on the content of the @qso-array: $sql2 = "AND `CALL` LIKE '\%$qso[0]\%' " if $qso[0]; - if ($qso[1]) { - $sql2 .= "AND DATE = '".substr($qso[1],4,4).'-'.substr($qso[1],2,2).'-' - .substr($qso[1],0,2)."' "; - } + if ($qso[1]) { + $sql2 .= "AND DATE = '".substr($qso[1],4,4).'-'.substr($qso[1],2,2).'-' + .substr($qso[1],0,2)."' "; + } $sql2 .= "AND `BAND` ='$qso[4]' " if $qso[4]; $sql2 .= "AND `MODE`='$qso[5]' " if $qso[5]; $sql2 .= "AND `QTH` LIKE '\%$qso[6]\%' " if $qso[6]; @@ -3988,133 +3988,133 @@ sub choseeditqso { $sql2 .= "AND `OPERATOR`='$qso[24]' " if $qso[24]; $sql2 .= "AND `GRID`='$qso[25]' " if $qso[25]; - # We have to know how many QSOs are fitting the current search criteria: + # We have to know how many QSOs are fitting the current search criteria: - my $eq = $dbh->prepare("SELECT count(*) from log_$mycall where 1 $sql2;"); - $eq->execute(); - $count = $eq->fetchrow_array(); - - if ($count == 0) { return 0 }; # no QSO to edit-> $editnr = 0. + my $eq = $dbh->prepare("SELECT count(*) from log_$mycall where 1 $sql2;"); + $eq->execute(); + $count = $eq->fetchrow_array(); + + if ($count == 0) { return 0 }; # no QSO to edit-> $editnr = 0. - # Calculate offset and aline for last cursor position different from 1. + # Calculate offset and aline for last cursor position different from 1. - if ($$pos > $nlines) { - $offset = int(($$pos-1) / $nlines) * $nlines; - $aline = $$pos-1 - $offset; - } - else {$aline = $$pos-1;} + if ($$pos > $nlines) { + $offset = int(($$pos-1) / $nlines) * $nlines; + $aline = $$pos-1 - $offset; + } + else {$aline = $$pos-1;} do { - my $eq = $dbh->prepare($sql.$sql2." ORDER BY `DATE`, `T_ON` LIMIT $offset, $nlines;"); - $eq->execute(); - my ($nr, $call, $name, $date, $time, $band, $mode, # temp vars - $qsls, $qslr, $dxcc, $qslinfo, $qslrl); - $eq->bind_columns(\$nr,\$call,\$name, \$date,\$time,\$band,\$mode, - \$qsls,\$qslr,\$dxcc,\$qslinfo, \$qslrl); - - my $y = 0; # y cordinate in the window (absolute position) - while ($eq->fetch()) { # QSO available - $time = substr($time, 0,5); # cut seconds from time - my $line = sprintf("%-6s %-14s %-12s %-8s %-5s %4s %-4s %1s %1s %1s %-4s%-9s", - $nr, $call, $name, $date, $time, $band, $mode, $qsls, - $qslr, $qslrl, $dxcc, $qslinfo); - if ($y == $aline) { # highlight line? - attron($win, COLOR_PAIR(3)); # highlight - $ret = $nr; # remember NR - } - addstr($win, $y, 0, $line); - attron($win, COLOR_PAIR(4)); # restore normal color - ($y < $nlines) ? $y++ : last; # prints first rows - } - for (;$y < $nlines;$y++) { # for the remaining rows - addstr($win, $y, 0, " "x80); # fill with whitespace - } - refresh($win); - - $ch = &getch2(); # Get keyboard input - - if ($ch eq KEY_DOWN) { # arrow key down was pressed - # 1. Can we go down => $$pos < $count? - # 2. do we have to scroll down? => $aline < 15? - if ($$pos < $count) { # we can go down! - if ($aline < ($nlines-1)) { # stay on same page - $aline++; - $$pos++; - } - else { # scroll down! - $offset += $nlines; # next QSOs from DB! - $aline=0; # start at first (highest) line - $$pos++; - } - } - } # key down - - elsif ($ch eq KEY_UP) { # arrow key down was pressed - # 1. Can we go up => $$pos > 1? - # 2. do we have to scroll up? => $aline = 0? - if ($$pos > 1) { # we can go up! - if ($aline > 0) { # stay on same page - $aline--; - $$pos--; - } - else { # scroll up! - $offset -= $nlines; # prev QSOs from DB! - $aline=$nlines-1; # start at lowest line - $$pos--; - } - } - } # key up - - elsif ($ch eq KEY_NPAGE) { # scroll a full page down - # can we scroll? are there more QSOs than fit on the current page? - if (($$pos-$aline+$nlines) < $count) { - $offset += $nlines; # scroll a page - $$pos += ($nlines - $aline); # consider $aline! - $aline=0; - } + my $eq = $dbh->prepare($sql.$sql2." ORDER BY `DATE`, `T_ON` LIMIT $offset, $nlines;"); + $eq->execute(); + my ($nr, $call, $name, $date, $time, $band, $mode, # temp vars + $qsls, $qslr, $dxcc, $qslinfo, $qslrl); + $eq->bind_columns(\$nr,\$call,\$name, \$date,\$time,\$band,\$mode, + \$qsls,\$qslr,\$dxcc,\$qslinfo, \$qslrl); + + my $y = 0; # y cordinate in the window (absolute position) + while ($eq->fetch()) { # QSO available + $time = substr($time, 0,5); # cut seconds from time + my $line = sprintf("%-6s %-14s %-12s %-8s %-5s %4s %-4s %1s %1s %1s %-4s%-9s", + $nr, $call, $name, $date, $time, $band, $mode, $qsls, + $qslr, $qslrl, $dxcc, $qslinfo); + if ($y == $aline) { # highlight line? + attron($win, COLOR_PAIR(3)); # highlight + $ret = $nr; # remember NR + } + addstr($win, $y, 0, $line); + attron($win, COLOR_PAIR(4)); # restore normal color + ($y < $nlines) ? $y++ : last; # prints first rows + } + for (;$y < $nlines;$y++) { # for the remaining rows + addstr($win, $y, 0, " "x80); # fill with whitespace + } + refresh($win); + + $ch = &getch2(); # Get keyboard input + + if ($ch eq KEY_DOWN) { # arrow key down was pressed + # 1. Can we go down => $$pos < $count? + # 2. do we have to scroll down? => $aline < 15? + if ($$pos < $count) { # we can go down! + if ($aline < ($nlines-1)) { # stay on same page + $aline++; + $$pos++; + } + else { # scroll down! + $offset += $nlines; # next QSOs from DB! + $aline=0; # start at first (highest) line + $$pos++; + } + } + } # key down + + elsif ($ch eq KEY_UP) { # arrow key down was pressed + # 1. Can we go up => $$pos > 1? + # 2. do we have to scroll up? => $aline = 0? + if ($$pos > 1) { # we can go up! + if ($aline > 0) { # stay on same page + $aline--; + $$pos--; + } + else { # scroll up! + $offset -= $nlines; # prev QSOs from DB! + $aline=$nlines-1; # start at lowest line + $$pos--; + } + } + } # key up + + elsif ($ch eq KEY_NPAGE) { # scroll a full page down + # can we scroll? are there more QSOs than fit on the current page? + if (($$pos-$aline+$nlines) < $count) { + $offset += $nlines; # scroll a page + $$pos += ($nlines - $aline); # consider $aline! + $aline=0; + } flushinp(); - } - - elsif ($ch eq KEY_PPAGE) { # scroll a full page up - # can we scroll? - if (($$pos-$aline) > $nlines) { - $offset -= $nlines; # scroll a page - $$pos -= ($aline+1); # consider $aline! - $aline=$nlines-1; - } + } + + elsif ($ch eq KEY_PPAGE) { # scroll a full page up + # can we scroll? + if (($$pos-$aline) > $nlines) { + $offset -= $nlines; # scroll a page + $$pos -= ($aline+1); # consider $aline! + $aline=$nlines-1; + } flushinp(); - } - - elsif ($ch eq KEY_HOME) { # go to first qso - $$pos = 1; - $aline = 0; - $offset = 0; - } - - elsif ($ch eq KEY_END) { # go to last qso - $$pos = $count; - $offset = int(($count-1) / $nlines) * $nlines; - $aline = $count-1 - $offset; - } - elsif ($ch eq KEY_F(1)) { # F1 -> Back to main menu - return 'm'; - } - - elsif ($ch eq KEY_F(3)) { # F3 -> Cancel search - return 'c'; - } - - elsif ($ch eq KEY_F(12)) { # F12 -> Exit, QRT - endwin(); - exit; - } - - elsif ($ch =~ /\s/) { # Chose this QSO for editing - return $ret; - } - -} while ($goon); # loop until goon = 0 (erm, it never changes?) - + } + + elsif ($ch eq KEY_HOME) { # go to first qso + $$pos = 1; + $aline = 0; + $offset = 0; + } + + elsif ($ch eq KEY_END) { # go to last qso + $$pos = $count; + $offset = int(($count-1) / $nlines) * $nlines; + $aline = $count-1 - $offset; + } + elsif ($ch eq KEY_F(1)) { # F1 -> Back to main menu + return 'm'; + } + + elsif ($ch eq KEY_F(3)) { # F3 -> Cancel search + return 'c'; + } + + elsif ($ch eq KEY_F(12)) { # F12 -> Exit, QRT + endwin(); + exit; + } + + elsif ($ch =~ /\s/) { # Chose this QSO for editing + return $ret; + } + +} while ($goon); # loop until goon = 0 (erm, it never changes?) + } # choseeditqso ############################################################################## @@ -4123,11 +4123,11 @@ do { ############################################################################## sub geteditqso { -my @qso; # QSO array +my @qso; # QSO array my $q = $dbh->prepare("SELECT `CALL`, `DATE`, `T_ON`, `T_OFF`, `BAND`, `MODE`, - `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR`, `DXCC`, - `PFX`, `CONT`, `ITUZ`, `CQZ`, `QSLINFO`, `IOTA`, `STATE`, `NR`, - `QSLRL`, `OPERATOR`, `GRID` FROM log_$mycall WHERE `NR`='$_[0]'"); + `QTH`, `NAME`, `QSLS`, `QSLR`, `RSTS`, `RSTR`, `REM`, `PWR`, `DXCC`, + `PFX`, `CONT`, `ITUZ`, `CQZ`, `QSLINFO`, `IOTA`, `STATE`, `NR`, + `QSLRL`, `OPERATOR`, `GRID` FROM log_$mycall WHERE `NR`='$_[0]'"); $q->execute; @qso = $q->fetchrow_array; # proper format for the date (yyyy-mm-dd -> ddmmyyyy) @@ -4136,9 +4136,9 @@ $qso[1] = substr($qso[1],8,2).substr($qso[1],5,2).substr($qso[1],0,4); $qso[2] = substr($qso[2],0,2).substr($qso[2],3,2); $qso[3] = substr($qso[3],0,2).substr($qso[3],3,2); -for (my $x=0;$x < 26;$x++) { # iterate through all input windows - addstr(${$_[1]}[$x],0,0,$qso[$x]); # add new value from @qso. - refresh(${$_[1]}[$x]); +for (my $x=0;$x < 26;$x++) { # iterate through all input windows + addstr(${$_[1]}[$x],0,0,$qso[$x]); # add new value from @qso. + refresh(${$_[1]}[$x]); } return @qso; @@ -4174,224 +4174,224 @@ return @qso; ############################################################################## sub editw { - my $ch; # the getchar() we read - my $win = ${$_[0]}[$_[2]]; # get window to modify - my $input = ${$_[3]}[$_[2]]; # stores what the user entered, - # init from @qso. - my $match = "[a-zA-Z0-9\/]"; # default match expression - my $pos = 0; # cursor position in the field - my $strpos = $pos; # cursor position in the string - - my $debug=0; - - my $ovr = $_[4]; - my $width = $_[5]; - - # The string length $strlen is used to have entries larger than the width, - # $_[2] is inspected to set the length according to SQL field length. - my $strlen = $width; - if ($_[2] == 0) { $strlen = 15; } # Call - elsif ($_[2] == 5) { $strlen = 6; } # Mode - elsif ($_[2] == 6) { $strlen = 15; } # QTH - elsif ($_[2] == 7) { $strlen = 15; } # Name - elsif ($_[2] == 10) { $strlen = 10; } # RSTs - elsif ($_[2] == 11) { $strlen = 10; } # RSTr - elsif ($_[2] == 12) { $strlen = 60; } # Remarks - elsif ($_[2] == 13) { $strlen = 10; } # PWR - - move($win,0,0); # move cursor to first position - addstr($win,0,0, $input." "x80); # pass $input to window, - refresh($win); - - # For the date, time and band only figures are allowed, - # to achieve this, invoke editw with $_[1] = 1 - if ((defined $_[1]) && ($_[1] == "1")) { # only numbers - $match = '\d'; # set match expression - } - - # For the QSL-status only letters are allowed, - # to achieve this, invoke editw with $_[1] = 2 - if ((defined $_[1]) && ($_[1] == "2")) { # only letters - $match = '[a-zA-Z]'; # set match expression - } - - # For the Name, QTH and Remarks letters, figures and punctuation is allowed - # to achieve this, invoke editw with $_[1] = 3 - if ((defined $_[1]) && ($_[1] == "3")) { - $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # set match expression - } - - # Band info needs numbers and decimal point - if ((defined $_[1]) && ($_[1] == "4")) { - $match = '[0-9.]'; # set match expression - } - - # Now the main loop starts which is waiting for any input from the keyboard - # which is stored in $ch. If it is a valid character that matches $match, - # it will be added to the string $input at the proper place. - - while (1) { # loop infinitely - - $pos-- if ($pos == $width); # keep cursor in window - $strpos-- if ($strpos == $strlen); # stop if string filled - - # If the cursor positions in the field and the string are not the same - # then give only a partial view of the string. - if ($strpos > $pos) { - if (length($input) < $width) { - $pos = $strpos; # perfect, it fits again - } - addstr($win,0,0, substr($input, $strpos-$pos, )." "x80); - } - else { - addstr($win,0,0, $input." "x80); # pass $input to window, - } # delete all after $input. - - move ($win,0,$pos); # move cursor to $pos - refresh($win); # show new window - - $ch = &getch2; # wait for a character - - # We first check if it is a legal character of the specified $match, - # if so, it will be added to the string (at the proper position!) - if (($ch =~ /^$match$/) && - ((length($input) < $strlen) || ($strpos < $strlen && $ovr)) - ) { - unless ($_[1] == 3) { # Unless Name, QTH, Remarks - $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase - } - # The new character will be added to $input at the right place. - $strpos++; - $pos++; - - if ($ovr) { - $input = substr($input, 0, $strpos-1).$ch.substr($input, - $strpos > length($input) ? $strpos-1 : $strpos, ); - } - else { - $input = substr($input, 0, $strpos-1).$ch.substr($input, - $strpos-1, ); - } - } - - # The l/r arrow keys change the position of the cursor to left or right - # but only within the boundaries of $input. - - elsif ($ch eq KEY_LEFT) { # arrow left was pressed - if ($pos > 0) { $pos-- } # go left if possible - if ($strpos > 0) { $strpos-- } - } - - elsif ($ch eq KEY_RIGHT) { # arrow right was pressed - if (($pos < length($input)) && ($pos < $width)) { $pos++ } - if ($strpos < length($input)) { $strpos++ }# go right if possible - } - - elsif ($ch eq KEY_HOME) { # Pos1 key - $pos = 0; - $strpos = 0; - } - - elsif ($ch eq KEY_END) { # End key - $strpos = length($input); - if ($strpos >= $strlen) {$strpos = $strlen-1;} - $pos = $strpos; - if ($pos >= $width) {$pos = $width-1;} - } - - elsif (($ch eq KEY_DC) && ($strpos < length($input))) { # Delete key - $input = substr($input, 0, $strpos).substr($input, $strpos+1, ); - } - - # BACKSPACE. When pressing backspace, the character left of the cursor - # is deleted, if it exists. For some reason, KEY_BACKSPACE only is true - # when pressing CTL+H on my system (and all the others I tested); the - # other tests lead to success, although it's probably less portable. - # Found this solution in qe.pl by Wilbert Knol, ZL2BSJ. - - elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) - && ($strpos > 0)) { - $input = substr($input, 0, $strpos-1).substr($input, $strpos, ); - $strpos--; - if ($pos > 0) { $pos--; } - } - - # Space, Tab and Enter are the keys to go to the next field, except in - # mode $_[1], where it was already caught in the first pattern match. - # If space, tab or newline is found, the sub puts $input into the - # proper place in the @qso array: ${$_[3]}[$_[2]]; - elsif ($ch =~ /^[ \t\n]$/) { # Space, Tab or Newline - ${$_[3]}[$_[2]] = $input; # save to @qso.return 0; - return 1; - } - # If the pressed key was F2, we will save; that is, when the qso array - # has sufficient information for a good QSO. Then the qso-array - # and the input fields are deleted. - # This only works when $qso[22] = NR is not 0, which means that we - # are not editing a QSO but getting search criteria. - elsif ($ch eq KEY_F(2) && ${$_[3]}[22]) { # pressed F2 -> SAVE - ${$_[3]}[$_[2]] = $input; # save field to @qso - if (&updateqso(\@{$_[3]})) { # save changes in @qso to DB - &clearinputfields($_[0],2); # clear input fields 0..22 - for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. - return 0; # success, leave editw - } # if no success, we continue in the loop. - } - - # exit to the MAIN MENU - elsif ($ch eq KEY_F(1)) { - return 'm'; # -> MENU! - } - - # F3 clears the current QSO and returns to the CALL input field. - elsif ($ch eq KEY_F(3)) { # F3 pressed -> clear QSO - for (0 .. 25) { # iterate through windows 0-13 - addstr(@{$_[0]}[$_],0,0," "x80); # clear it - refresh(@{$_[0]}[$_]); - } - for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. - return 0; # return 0 (= go back to callsign) - } - - # F4 --> delete the QSO, but first ask if really wany to delete it. - # Then delete it and clear all fields, like with F3. - elsif ($ch eq KEY_F(4) && ${$_[3]}[22]) { # pressed F4 -> delete QSO - my $answer = &askbox(7,0,4,80,'\w', - "Are you sure you want to delete the above QSO *permanently*? (yes/no)", ''); - if ($answer eq 'm') { return 2 } # menu - elsif ($answer eq 'yes') { # yes, delete! - $dbh->do("DELETE from log_$mycall WHERE NR='${$_[3]}[22]'"); - for (0 .. 25) { # iterate through windows - addstr(@{$_[0]}[$_],0,0," "x80); # clear it - refresh(@{$_[0]}[$_]); - } - for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. - return 0; # return 0 (= go back to callsign) - }; - - } - - # F5 -> We want to search the DB for the given criteria... - elsif ($ch eq KEY_F(5)) { - ${$_[3]}[$_[2]] = $input; # save field to @qso - return 2; - } - - # QUIT YFKlog - elsif ($ch eq KEY_F(12)) { # QUIT - my $k='y'; - - if ($askme && ${$_[3]}[0] ne '') { - $k = &askconfirmation("Really quit YFKlog? [y/N]", - 'y|n|\n|\s'); - } - - if ($k =~ /y/i) { - endwin; # Leave curses mode - exit; - } - } - } + my $ch; # the getchar() we read + my $win = ${$_[0]}[$_[2]]; # get window to modify + my $input = ${$_[3]}[$_[2]]; # stores what the user entered, + # init from @qso. + my $match = "[a-zA-Z0-9\/]"; # default match expression + my $pos = 0; # cursor position in the field + my $strpos = $pos; # cursor position in the string + + my $debug=0; + + my $ovr = $_[4]; + my $width = $_[5]; + + # The string length $strlen is used to have entries larger than the width, + # $_[2] is inspected to set the length according to SQL field length. + my $strlen = $width; + if ($_[2] == 0) { $strlen = 15; } # Call + elsif ($_[2] == 5) { $strlen = 6; } # Mode + elsif ($_[2] == 6) { $strlen = 15; } # QTH + elsif ($_[2] == 7) { $strlen = 15; } # Name + elsif ($_[2] == 10) { $strlen = 10; } # RSTs + elsif ($_[2] == 11) { $strlen = 10; } # RSTr + elsif ($_[2] == 12) { $strlen = 60; } # Remarks + elsif ($_[2] == 13) { $strlen = 10; } # PWR + + move($win,0,0); # move cursor to first position + addstr($win,0,0, $input." "x80); # pass $input to window, + refresh($win); + + # For the date, time and band only figures are allowed, + # to achieve this, invoke editw with $_[1] = 1 + if ((defined $_[1]) && ($_[1] == "1")) { # only numbers + $match = '\d'; # set match expression + } + + # For the QSL-status only letters are allowed, + # to achieve this, invoke editw with $_[1] = 2 + if ((defined $_[1]) && ($_[1] == "2")) { # only letters + $match = '[a-zA-Z]'; # set match expression + } + + # For the Name, QTH and Remarks letters, figures and punctuation is allowed + # to achieve this, invoke editw with $_[1] = 3 + if ((defined $_[1]) && ($_[1] == "3")) { + $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # set match expression + } + + # Band info needs numbers and decimal point + if ((defined $_[1]) && ($_[1] == "4")) { + $match = '[0-9.]'; # set match expression + } + + # Now the main loop starts which is waiting for any input from the keyboard + # which is stored in $ch. If it is a valid character that matches $match, + # it will be added to the string $input at the proper place. + + while (1) { # loop infinitely + + $pos-- if ($pos == $width); # keep cursor in window + $strpos-- if ($strpos == $strlen); # stop if string filled + + # If the cursor positions in the field and the string are not the same + # then give only a partial view of the string. + if ($strpos > $pos) { + if (length($input) < $width) { + $pos = $strpos; # perfect, it fits again + } + addstr($win,0,0, substr($input, $strpos-$pos, )." "x80); + } + else { + addstr($win,0,0, $input." "x80); # pass $input to window, + } # delete all after $input. + + move ($win,0,$pos); # move cursor to $pos + refresh($win); # show new window + + $ch = &getch2; # wait for a character + + # We first check if it is a legal character of the specified $match, + # if so, it will be added to the string (at the proper position!) + if (($ch =~ /^$match$/) && + ((length($input) < $strlen) || ($strpos < $strlen && $ovr)) + ) { + unless ($_[1] == 3) { # Unless Name, QTH, Remarks + $ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase + } + # The new character will be added to $input at the right place. + $strpos++; + $pos++; + + if ($ovr) { + $input = substr($input, 0, $strpos-1).$ch.substr($input, + $strpos > length($input) ? $strpos-1 : $strpos, ); + } + else { + $input = substr($input, 0, $strpos-1).$ch.substr($input, + $strpos-1, ); + } + } + + # The l/r arrow keys change the position of the cursor to left or right + # but only within the boundaries of $input. + + elsif ($ch eq KEY_LEFT) { # arrow left was pressed + if ($pos > 0) { $pos-- } # go left if possible + if ($strpos > 0) { $strpos-- } + } + + elsif ($ch eq KEY_RIGHT) { # arrow right was pressed + if (($pos < length($input)) && ($pos < $width)) { $pos++ } + if ($strpos < length($input)) { $strpos++ }# go right if possible + } + + elsif ($ch eq KEY_HOME) { # Pos1 key + $pos = 0; + $strpos = 0; + } + + elsif ($ch eq KEY_END) { # End key + $strpos = length($input); + if ($strpos >= $strlen) {$strpos = $strlen-1;} + $pos = $strpos; + if ($pos >= $width) {$pos = $width-1;} + } + + elsif (($ch eq KEY_DC) && ($strpos < length($input))) { # Delete key + $input = substr($input, 0, $strpos).substr($input, $strpos+1, ); + } + + # BACKSPACE. When pressing backspace, the character left of the cursor + # is deleted, if it exists. For some reason, KEY_BACKSPACE only is true + # when pressing CTL+H on my system (and all the others I tested); the + # other tests lead to success, although it's probably less portable. + # Found this solution in qe.pl by Wilbert Knol, ZL2BSJ. + + elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) + && ($strpos > 0)) { + $input = substr($input, 0, $strpos-1).substr($input, $strpos, ); + $strpos--; + if ($pos > 0) { $pos--; } + } + + # Space, Tab and Enter are the keys to go to the next field, except in + # mode $_[1], where it was already caught in the first pattern match. + # If space, tab or newline is found, the sub puts $input into the + # proper place in the @qso array: ${$_[3]}[$_[2]]; + elsif ($ch =~ /^[ \t\n]$/) { # Space, Tab or Newline + ${$_[3]}[$_[2]] = $input; # save to @qso.return 0; + return 1; + } + # If the pressed key was F2, we will save; that is, when the qso array + # has sufficient information for a good QSO. Then the qso-array + # and the input fields are deleted. + # This only works when $qso[22] = NR is not 0, which means that we + # are not editing a QSO but getting search criteria. + elsif ($ch eq KEY_F(2) && ${$_[3]}[22]) { # pressed F2 -> SAVE + ${$_[3]}[$_[2]] = $input; # save field to @qso + if (&updateqso(\@{$_[3]})) { # save changes in @qso to DB + &clearinputfields($_[0],2); # clear input fields 0..22 + for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. + return 0; # success, leave editw + } # if no success, we continue in the loop. + } + + # exit to the MAIN MENU + elsif ($ch eq KEY_F(1)) { + return 'm'; # -> MENU! + } + + # F3 clears the current QSO and returns to the CALL input field. + elsif ($ch eq KEY_F(3)) { # F3 pressed -> clear QSO + for (0 .. 25) { # iterate through windows 0-13 + addstr(@{$_[0]}[$_],0,0," "x80); # clear it + refresh(@{$_[0]}[$_]); + } + for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. + return 0; # return 0 (= go back to callsign) + } + + # F4 --> delete the QSO, but first ask if really wany to delete it. + # Then delete it and clear all fields, like with F3. + elsif ($ch eq KEY_F(4) && ${$_[3]}[22]) { # pressed F4 -> delete QSO + my $answer = &askbox(7,0,4,80,'\w', + "Are you sure you want to delete the above QSO *permanently*? (yes/no)", ''); + if ($answer eq 'm') { return 2 } # menu + elsif ($answer eq 'yes') { # yes, delete! + $dbh->do("DELETE from log_$mycall WHERE NR='${$_[3]}[22]'"); + for (0 .. 25) { # iterate through windows + addstr(@{$_[0]}[$_],0,0," "x80); # clear it + refresh(@{$_[0]}[$_]); + } + for (0 .. 25) { ${$_[3]}[$_] = ''; } # clear @qso. + return 0; # return 0 (= go back to callsign) + }; + + } + + # F5 -> We want to search the DB for the given criteria... + elsif ($ch eq KEY_F(5)) { + ${$_[3]}[$_[2]] = $input; # save field to @qso + return 2; + } + + # QUIT YFKlog + elsif ($ch eq KEY_F(12)) { # QUIT + my $k='y'; + + if ($askme && ${$_[3]}[0] ne '') { + $k = &askconfirmation("Really quit YFKlog? [y/N]", + 'y|n|\n|\s'); + } + + if ($k =~ /y/i) { + endwin; # Leave curses mode + exit; + } + } + } } # &editw; @@ -4401,56 +4401,56 @@ sub editw { ############################################################################## sub updateqso { - my @qso = @{$_[0]}; # QSO array (0 .. 25) - - $qso[1] = substr($qso[1],0,8); # cut date and times if needed - $qso[2] = substr($qso[2],0,4); - $qso[3] = substr($qso[3],0,4); - - # Now we have to check if it is a valid entry - if ((&wpx($qso[0]) ) && # check for a valid callsign - (length($qso[1]) == 8) && # check if date has proper length - (substr($qso[1],0,2) < 32) && # sane day (of course not in all months) - (substr($qso[1],2,2) < 13) && # valid month - (substr($qso[1],4,) > 1900) && # :-) - (length($qso[2]) == 4) && # check length of time on - (substr($qso[2],0,2) < 24) && # valid hour in Time on - (substr($qso[2],3,2) < 60) && # valid minute Time on - ($qso[4] ne '') && # band has some info - ($qso[5] ne '') && # mode has some info - ($qso[8] ne '') && # QSL sent - ($qso[9] ne '') && # QSL rxed - ($qso[16] =~ /^(AS|EU|AF|NA|SA|OC|AN)$/) && # continent - (($qso[17] > 0) && ($qso[17] < 91)) && # ITU Zone - (($qso[18] > 0) && ($qso[18] < 41)) && # CQ Zone - ($qso[20] =~ /(^$qso[16]-\d\d\d$)|(^$)/)&& # valid or no IOTA - ($qso[21] =~ /^([A-Z]{1,2})?$/) # "valid" state - # RST, PWR not checked, will be 599 / 0 by default in the database, - ) { # VALID ENTRY! update into database - - $qso[1] = # put date in YYYY-MM-DD format - substr($qso[1],4,)."-".substr($qso[1],2,2)."-".substr($qso[1],0,2); - $qso[2] = substr($qso[2],0,2).":".substr($qso[2],2,2).":00";# add seconds, : - $qso[3] = substr($qso[3],0,2).":".substr($qso[3],2,2).":00";# add seconds, : - - # we are now ready to save the QSO - $dbh->do("UPDATE log_$mycall SET `CALL`='$qso[0]', `DATE`='$qso[1]', - `T_ON`='$qso[2]', `T_OFF`='$qso[3]', `BAND`='$qso[4]', - `MODE`='$qso[5]', `QTH`='$qso[6]', `NAME`='$qso[7]', - `QSLS`='$qso[8]', `QSLR`='$qso[9]', `RSTS`='$qso[10]', - `RSTR`='$qso[11]', `REM`='$qso[12]', `PWR`='$qso[13]', - `DXCC`='$qso[14]', `PFX`='$qso[15]', `CONT`='$qso[16]', - `ITUZ`='$qso[17]', `CQZ`='$qso[18]', - `QSLINFO`='$qso[19]', `IOTA`='$qso[20]', - `STATE`='$qso[21]', `QSLRL`='$qso[23]', `OPERATOR` = - '$qso[24]', `GRID` = '$qso[25]' - WHERE `NR`='$qso[22]';"); - return 1; # successfully saved - } - else { - &finderror(@qso); - return 0; # No success, QSO not complete! - } + my @qso = @{$_[0]}; # QSO array (0 .. 25) + + $qso[1] = substr($qso[1],0,8); # cut date and times if needed + $qso[2] = substr($qso[2],0,4); + $qso[3] = substr($qso[3],0,4); + + # Now we have to check if it is a valid entry + if ((&wpx($qso[0]) ) && # check for a valid callsign + (length($qso[1]) == 8) && # check if date has proper length + (substr($qso[1],0,2) < 32) && # sane day (of course not in all months) + (substr($qso[1],2,2) < 13) && # valid month + (substr($qso[1],4,) > 1900) && # :-) + (length($qso[2]) == 4) && # check length of time on + (substr($qso[2],0,2) < 24) && # valid hour in Time on + (substr($qso[2],3,2) < 60) && # valid minute Time on + ($qso[4] ne '') && # band has some info + ($qso[5] ne '') && # mode has some info + ($qso[8] ne '') && # QSL sent + ($qso[9] ne '') && # QSL rxed + ($qso[16] =~ /^(AS|EU|AF|NA|SA|OC|AN)$/) && # continent + (($qso[17] > 0) && ($qso[17] < 91)) && # ITU Zone + (($qso[18] > 0) && ($qso[18] < 41)) && # CQ Zone + ($qso[20] =~ /(^$qso[16]-\d\d\d$)|(^$)/)&& # valid or no IOTA + ($qso[21] =~ /^([A-Z]{1,2})?$/) # "valid" state + # RST, PWR not checked, will be 599 / 0 by default in the database, + ) { # VALID ENTRY! update into database + + $qso[1] = # put date in YYYY-MM-DD format + substr($qso[1],4,)."-".substr($qso[1],2,2)."-".substr($qso[1],0,2); + $qso[2] = substr($qso[2],0,2).":".substr($qso[2],2,2).":00";# add seconds, : + $qso[3] = substr($qso[3],0,2).":".substr($qso[3],2,2).":00";# add seconds, : + + # we are now ready to save the QSO + $dbh->do("UPDATE log_$mycall SET `CALL`='$qso[0]', `DATE`='$qso[1]', + `T_ON`='$qso[2]', `T_OFF`='$qso[3]', `BAND`='$qso[4]', + `MODE`='$qso[5]', `QTH`='$qso[6]', `NAME`='$qso[7]', + `QSLS`='$qso[8]', `QSLR`='$qso[9]', `RSTS`='$qso[10]', + `RSTR`='$qso[11]', `REM`='$qso[12]', `PWR`='$qso[13]', + `DXCC`='$qso[14]', `PFX`='$qso[15]', `CONT`='$qso[16]', + `ITUZ`='$qso[17]', `CQZ`='$qso[18]', + `QSLINFO`='$qso[19]', `IOTA`='$qso[20]', + `STATE`='$qso[21]', `QSLRL`='$qso[23]', `OPERATOR` = + '$qso[24]', `GRID` = '$qso[25]' + WHERE `NR`='$qso[22]';"); + return 1; # successfully saved + } + else { + &finderror(@qso); + return 0; # No success, QSO not complete! + } } # updateqso ############################################################################## @@ -4459,17 +4459,17 @@ sub updateqso { ############################################################################## sub checkdate { - my $date = $_[0]; # the date we want to check - - unless ($date =~ /^\d{4,4}-(\d\d)-(\d\d)$/) { return 0; } # crude check - # $1 is the month and $2 the day. We assume that any - # year is valid. - - unless (($1 < 13) && ($1 != 0)) { return 0; } # month 0 or 13+ - unless (($1 < 32) && ($1 != 0)) { return 0; } # day 0 or 32+ - - # OK, if we get until here, the date is valid. - return 1; + my $date = $_[0]; # the date we want to check + + unless ($date =~ /^\d{4,4}-(\d\d)-(\d\d)$/) { return 0; } # crude check + # $1 is the month and $2 the day. We assume that any + # year is valid. + + unless (($1 < 13) && ($1 != 0)) { return 0; } # month 0 or 13+ + unless (($1 < 32) && ($1 != 0)) { return 0; } # day 0 or 32+ + + # OK, if we get until here, the date is valid. + return 1; } @@ -4483,120 +4483,120 @@ sub checkdate { ############################################################################## sub awards { - my $daterange = $_[0]; # SQL String with date range - my $awardtype = $_[1]; - my @bands = split(/\s+/, $_[6]); # Generate list of Bands for awards - my @modes = split(/\s+/, $_[7]); # modes to query - my $custom = $_[8]; - my %result; # key=band, value=dxccs WORKED - my %resultcp; # key=band, value=dxccs CFMED paper QSLs - my %resultcl; # key=band, value=dxccs CFMED LOTW QSLs - my %resultc; # key=band, value=dxccs CFMED combined - my %abdxcc; # allband DXCCs combined. 'dxcc'->0/1 - my %abdxcccp; # same, but QSL received/confirmed - my %abdxcccl; # same, but LOTW received/confirmed - my %abdxccc; # same, but QSL|LOTW received/confirmed - my %sumdxcc; # "DL"->"160 20 15 10" worked - my %sumdxccc; # "DL"->"160" cfmed combined - my %sumdxcccp; # "DL"->"160" cfmed paper - my %sumdxcccl; # "DL"->"160" cfmed lotw - - foreach (@bands) { # reset results to 0 for all bands - $result{$_} = 0; - $resultc{$_} = 0; - $resultcp{$_} = 0; - $resultcl{$_} = 0; - } - - my $rband = 'BAND'; - if ($db ne 'sqlite') { - $rband = 'round(BAND,4)'; - } - - # create mode string for the IN statement - my $modes = "'" . join("','", @modes) . "'"; + my $daterange = $_[0]; # SQL String with date range + my $awardtype = $_[1]; + my @bands = split(/\s+/, $_[6]); # Generate list of Bands for awards + my @modes = split(/\s+/, $_[7]); # modes to query + my $custom = $_[8]; + my %result; # key=band, value=dxccs WORKED + my %resultcp; # key=band, value=dxccs CFMED paper QSLs + my %resultcl; # key=band, value=dxccs CFMED LOTW QSLs + my %resultc; # key=band, value=dxccs CFMED combined + my %abdxcc; # allband DXCCs combined. 'dxcc'->0/1 + my %abdxcccp; # same, but QSL received/confirmed + my %abdxcccl; # same, but LOTW received/confirmed + my %abdxccc; # same, but QSL|LOTW received/confirmed + my %sumdxcc; # "DL"->"160 20 15 10" worked + my %sumdxccc; # "DL"->"160" cfmed combined + my %sumdxcccp; # "DL"->"160" cfmed paper + my %sumdxcccl; # "DL"->"160" cfmed lotw + + foreach (@bands) { # reset results to 0 for all bands + $result{$_} = 0; + $resultc{$_} = 0; + $resultcp{$_} = 0; + $resultcl{$_} = 0; + } + + my $rband = 'BAND'; + if ($db ne 'sqlite') { + $rband = 'round(BAND,4)'; + } + + # create mode string for the IN statement + my $modes = "'" . join("','", @modes) . "'"; foreach my $band (@bands) { - my %dxccc; # hash to check if the entity is new and CONFIRMED - my %dxcccp; # hash to check if the entity is new and paper QSLed - my %dxcccl; # hash to check if the entity is new and LOTW QSLed - my %dxcc; # hash to check if the current entity is new. - - my ($sth, $dx, $qslr, $qslrl); - if ($custom) { - $sth = $dbh->prepare("SELECT REM, QSLR, QSLRL FROM - log_$mycall WHERE $rband='$band' AND MODE IN ($modes) - AND $daterange AND REM LIKE \"%$custom:%\""); - $sth->execute() or die "Error, couldn't select ($custom)!"; - $sth->bind_columns(\$dx, \$qslr, \$qslrl); - } - else { - $sth = $dbh->prepare("SELECT $awardtype, QSLR, QSLRL FROM - log_$mycall WHERE $rband='$band' AND $daterange - AND MODE IN ($modes)"); - - $sth->execute() or die "Error selecting $awardtype from log_$mycall!"; - $sth->bind_columns(\$dx,\$qslr, \$qslrl); - } - - - while ($sth->fetch()) { # go through all QSOs - if ($custom) { - if ($dx =~ /$custom:(.+?)(\s|$)/) { # $dx == remarks field here - $dx = $1; - } - else { - next; - } - } - - if ($dx eq '') { next; } # no entry for this award type - $dx =~ s/[A-Za-z]{2}$// if ($awardtype eq 'GRID'); - - unless (defined($dxcc{$dx})) { # DXCC not in hash -> new DXCC - $result{$band}++; # increase counter - $dxcc{$dx} = 1; # mark as worked in dxcc hash - $sumdxcc{$dx} .= $band.' '; # save band for overall stats - unless (defined($abdxcc{$dx})) { # new DXCC over all bands? - $abdxcc{$dx} = 1; # mark it worked - } - } - - # Paper QSL - - if (!defined($dxcccp{$dx}) && ($qslr eq 'Y')) { # paper QSL-received - $resultcp{$band}++; # increase counter - $dxcccp{$dx} =1; - $sumdxcccp{$dx} .= $band.' '; # save band for overall stats - unless (defined($abdxcccp{$dx})) { # new DXCC overall bands cfmed - $abdxcccp{$dx} = 1; # mark it confirmed! - } - } - - # LOTW QSL - - if (!defined($dxcccl{$dx}) && ($qslrl eq 'Y')) { # LOTW QSL-received - $resultcl{$band}++; # increase counter - $dxcccl{$dx} =1; - $sumdxcccl{$dx} .= $band.' '; # save band for overall stats - unless (defined($abdxcccl{$dx})) { # new DXCC overall bands cfmed - $abdxcccl{$dx} = 1; # mark it confirmed! - } - } - - # Combined - - if (!defined($dxccc{$dx}) && (($qslr eq 'Y')||($qslrl eq 'Y'))) { - $resultc{$band}++; - $dxccc{$dx} =1; - $sumdxccc{$dx} .= $band.' '; - unless (defined($abdxccc{$dx})) { - $abdxccc{$dx} = 1; - } - } - - - } + my %dxccc; # hash to check if the entity is new and CONFIRMED + my %dxcccp; # hash to check if the entity is new and paper QSLed + my %dxcccl; # hash to check if the entity is new and LOTW QSLed + my %dxcc; # hash to check if the current entity is new. + + my ($sth, $dx, $qslr, $qslrl); + if ($custom) { + $sth = $dbh->prepare("SELECT REM, QSLR, QSLRL FROM + log_$mycall WHERE $rband='$band' AND MODE IN ($modes) + AND $daterange AND REM LIKE \"%$custom:%\""); + $sth->execute() or die "Error, couldn't select ($custom)!"; + $sth->bind_columns(\$dx, \$qslr, \$qslrl); + } + else { + $sth = $dbh->prepare("SELECT $awardtype, QSLR, QSLRL FROM + log_$mycall WHERE $rband='$band' AND $daterange + AND MODE IN ($modes)"); + + $sth->execute() or die "Error selecting $awardtype from log_$mycall!"; + $sth->bind_columns(\$dx,\$qslr, \$qslrl); + } + + + while ($sth->fetch()) { # go through all QSOs + if ($custom) { + if ($dx =~ /$custom:(.+?)(\s|$)/) { # $dx == remarks field here + $dx = $1; + } + else { + next; + } + } + + if ($dx eq '') { next; } # no entry for this award type + $dx =~ s/[A-Za-z]{2}$// if ($awardtype eq 'GRID'); + + unless (defined($dxcc{$dx})) { # DXCC not in hash -> new DXCC + $result{$band}++; # increase counter + $dxcc{$dx} = 1; # mark as worked in dxcc hash + $sumdxcc{$dx} .= $band.' '; # save band for overall stats + unless (defined($abdxcc{$dx})) { # new DXCC over all bands? + $abdxcc{$dx} = 1; # mark it worked + } + } + + # Paper QSL + + if (!defined($dxcccp{$dx}) && ($qslr eq 'Y')) { # paper QSL-received + $resultcp{$band}++; # increase counter + $dxcccp{$dx} =1; + $sumdxcccp{$dx} .= $band.' '; # save band for overall stats + unless (defined($abdxcccp{$dx})) { # new DXCC overall bands cfmed + $abdxcccp{$dx} = 1; # mark it confirmed! + } + } + + # LOTW QSL + + if (!defined($dxcccl{$dx}) && ($qslrl eq 'Y')) { # LOTW QSL-received + $resultcl{$band}++; # increase counter + $dxcccl{$dx} =1; + $sumdxcccl{$dx} .= $band.' '; # save band for overall stats + unless (defined($abdxcccl{$dx})) { # new DXCC overall bands cfmed + $abdxcccl{$dx} = 1; # mark it confirmed! + } + } + + # Combined + + if (!defined($dxccc{$dx}) && (($qslr eq 'Y')||($qslrl eq 'Y'))) { + $resultc{$band}++; + $dxccc{$dx} =1; + $sumdxccc{$dx} .= $band.' '; + unless (defined($abdxccc{$dx})) { + $abdxccc{$dx} = 1; + } + } + + + } } # foreach band # now include the overall number into the result hash @@ -4610,7 +4610,7 @@ open HTML, ">$directory/$mycall-$awardtype.html"; # Generate Header and Table header my $string = "$awardtype Status for ". uc(join('/', split(/_/, $mycall))) . - " in " . join(', ', @modes); + " in " . join(', ', @modes); print HTML ""; print HTML "\n\n" . $string . "\n\n"; print HTML "\n

" . $string . "

\n"; @@ -4619,45 +4619,45 @@ print HTML "Produced with YFKlog.\n # Table heades for each band.... foreach my $band (@bands) { - print HTML ""; + print HTML ""; } print HTML "\n"; # For each of the worked DXCCs add W, C or nothing.. foreach my $key (sort keys %sumdxcc) { - $string = ""; - - $sumdxccc{$key} .= ''; # to make it defined for sure - $sumdxcccp{$key} .= ''; # to make it defined for sure - $sumdxcccl{$key} .= ''; # to make it defined for sure - - # qsl state: green - all qsl, yellow - band missing, red - all missing - my $qsl_state = ''; - # TODO Maybe use stuff like "CL"? - # now create a table cell for each band. either empty (not worked), W or C - foreach my $band (@bands) { - if ($sumdxcccp{$key} =~ /(^| )$band( |$)/) { # band w/paper QSL - $string .= ""; - if ( $qsl_state eq '' ) {$qsl_state = "green";} - elsif ( $qsl_state eq "red" ) {$qsl_state = "yellow";} - } - elsif ($sumdxcccl{$key} =~ /(^| )$band( |$)/) { # band w/LOTW QSL - $string .= ""; - if ( $qsl_state eq '' ) {$qsl_state = "green";} - elsif ( $qsl_state eq "red" ) {$qsl_state = "yellow";} - } - elsif ($sumdxcc{$key} =~/(^| )$band( |$)/) { # band worked! - $string .= ""; - if ( $qsl_state eq '' ) {$qsl_state = "red";} - elsif ( $qsl_state eq "green" ) {$qsl_state = "yellow";} - } - else { # not worked - $string .= ""; - } - } - if ( $qsl_state eq "green" ) {$string =~ s/#FFFFFF/#00FF00/;} - elsif ( $qsl_state eq "yellow" ) {$string =~ s/#FFFFFF/#FFFF00/;} - elsif ( $qsl_state eq "red" ) {$string =~ s/#FFFFFF/#FF0000/;} + $string = ""; + + $sumdxccc{$key} .= ''; # to make it defined for sure + $sumdxcccp{$key} .= ''; # to make it defined for sure + $sumdxcccl{$key} .= ''; # to make it defined for sure + + # qsl state: green - all qsl, yellow - band missing, red - all missing + my $qsl_state = ''; + # TODO Maybe use stuff like "CL"? + # now create a table cell for each band. either empty (not worked), W or C + foreach my $band (@bands) { + if ($sumdxcccp{$key} =~ /(^| )$band( |$)/) { # band w/paper QSL + $string .= ""; + if ( $qsl_state eq '' ) {$qsl_state = "green";} + elsif ( $qsl_state eq "red" ) {$qsl_state = "yellow";} + } + elsif ($sumdxcccl{$key} =~ /(^| )$band( |$)/) { # band w/LOTW QSL + $string .= ""; + if ( $qsl_state eq '' ) {$qsl_state = "green";} + elsif ( $qsl_state eq "red" ) {$qsl_state = "yellow";} + } + elsif ($sumdxcc{$key} =~/(^| )$band( |$)/) { # band worked! + $string .= ""; + if ( $qsl_state eq '' ) {$qsl_state = "red";} + elsif ( $qsl_state eq "green" ) {$qsl_state = "yellow";} + } + else { # not worked + $string .= ""; + } + } + if ( $qsl_state eq "green" ) {$string =~ s/#FFFFFF/#00FF00/;} + elsif ( $qsl_state eq "yellow" ) {$string =~ s/#FFFFFF/#FFFF00/;} + elsif ( $qsl_state eq "red" ) {$string =~ s/#FFFFFF/#FF0000/;} print HTML $string."\n"; } @@ -4665,28 +4665,28 @@ print HTML $string."\n"; # Summary line for WORKED print HTML ""; foreach my $band (@bands) { - print HTML "" + print HTML "" } print HTML "\n"; # Summary line for CONFIRMED overall print HTML ""; foreach my $band (@bands) { - print HTML "" + print HTML "" } print HTML "\n"; # Summary line for CONFIRMED QSL print HTML ""; foreach my $band (@bands) { - print HTML "" + print HTML "" } print HTML "\n"; # Summary line for CONFIRMED LOTW print HTML ""; foreach my $band (@bands) { - print HTML "" + print HTML "" } print HTML "\n
$band $band
$key C L W  
$key C L W  
wkd: $result{'All'} $result{$band} $result{$band}
cfm: $resultc{'All'} $resultc{$band} $resultc{$band}
QSL: $resultcp{'All'} $resultcp{$band} $resultcp{$band}
LOTW: $resultcl{'All'} $resultcl{$band} $resultcl{$band}
\n\n\n"; @@ -4707,76 +4707,76 @@ return 0; ############################################################################### sub statistics { - my $type = $_[0]; # Band, Continent...? - my $wmain = ${$_[1]}; # window - my $daterange = $_[2]; # SQL String with date range - my @bands = split(/\s+/, $_[3]); - my @modes = split(/\s+/, $_[4]); - - my %result; # '160'(m) -> '666' (QSOs); - # or 'EU' -> '3242', 'AF' -> '234'... - my $maxqsos=0; # band/continent with max QSOs - my $totalqsos=0; # number of total QSOs for percentage - - # create strings for the IN statement - my $bands = join(',', @bands); - my $modes = "'" . join("','", @modes) . "'"; - - my $sth = $dbh->prepare("SELECT $type FROM log_$mycall WHERE $daterange - and BAND in ($bands) and MODE in ($modes)"); - $sth->execute(); - my $type_item; - $sth->bind_columns(\$type_item); - while ($sth->fetch()) { # go through ALL QSOs - $result{$type_item}++; # Add QSO to the item... - } - - # Create a HTML-output of the full award score. - open HTML, ">$directory/$mycall-$type.html"; - - # Generate Header and Table header - my $string = "$type Statistics for ". uc(join('/', split(/_/, $mycall))) . - " in " . join(', ', @modes); - print HTML ""; - print HTML "\n\n" . $string . "\n\n"; - print HTML "\n

" . $string . "

\n"; - print HTML "Produced with YFKlog.\n - \n"; - - # Check nr of total QSOs and band with most QSOs. - foreach my $key (keys %result) { - if (($result{$key} > $maxqsos)) { - $maxqsos = $result{$key}; - } - $totalqsos += $result{$key}; - } - - # Now we know the maximum number of QSOs, so we can normalize the - # results and make a nice printout plus HTML code. - my $y = 5; - foreach my $key (sort {if($a=~/^\d+$/){$a <=> $b} else{$a cmp $b}} - keys %result) { - $y++; - addstr($wmain, $y, 10, "$key "); - attron($wmain, COLOR_PAIR(2)); - print HTML ""; - addstr($wmain, $y, 15, " "x$len); # print bar - attron($wmain, COLOR_PAIR(4)); - my $percent = sprintf("%.2f", 100*$result{$key}/$totalqsos); - addstr($wmain, $y, 16+$len, # Add nr,percentage - $result{$key}.' = '.$percent.'%' ); - print HTML "\n"; - } - print HTML "\n"; - print HTML "\n
$key"; - my $len = int(($result{$key}/$maxqsos)*40); # length of bar - if (($len == "0") and ($result{$key} > 0)) { # at least one - $len = 1; # if QSO was made - } - print HTML "bar$result{$key} = $percent%
Total:$totalqsos = 100%
\n\n\n"; - close HTML; - return 0; + my $type = $_[0]; # Band, Continent...? + my $wmain = ${$_[1]}; # window + my $daterange = $_[2]; # SQL String with date range + my @bands = split(/\s+/, $_[3]); + my @modes = split(/\s+/, $_[4]); + + my %result; # '160'(m) -> '666' (QSOs); + # or 'EU' -> '3242', 'AF' -> '234'... + my $maxqsos=0; # band/continent with max QSOs + my $totalqsos=0; # number of total QSOs for percentage + + # create strings for the IN statement + my $bands = join(',', @bands); + my $modes = "'" . join("','", @modes) . "'"; + + my $sth = $dbh->prepare("SELECT $type FROM log_$mycall WHERE $daterange + and BAND in ($bands) and MODE in ($modes)"); + $sth->execute(); + my $type_item; + $sth->bind_columns(\$type_item); + while ($sth->fetch()) { # go through ALL QSOs + $result{$type_item}++; # Add QSO to the item... + } + + # Create a HTML-output of the full award score. + open HTML, ">$directory/$mycall-$type.html"; + + # Generate Header and Table header + my $string = "$type Statistics for ". uc(join('/', split(/_/, $mycall))) . + " in " . join(', ', @modes); + print HTML ""; + print HTML "\n\n" . $string . "\n\n"; + print HTML "\n

" . $string . "

\n"; + print HTML "Produced with YFKlog.\n + \n"; + + # Check nr of total QSOs and band with most QSOs. + foreach my $key (keys %result) { + if (($result{$key} > $maxqsos)) { + $maxqsos = $result{$key}; + } + $totalqsos += $result{$key}; + } + + # Now we know the maximum number of QSOs, so we can normalize the + # results and make a nice printout plus HTML code. + my $y = 5; + foreach my $key (sort {if($a=~/^\d+$/){$a <=> $b} else{$a cmp $b}} + keys %result) { + $y++; + addstr($wmain, $y, 10, "$key "); + attron($wmain, COLOR_PAIR(2)); + print HTML ""; + addstr($wmain, $y, 15, " "x$len); # print bar + attron($wmain, COLOR_PAIR(4)); + my $percent = sprintf("%.2f", 100*$result{$key}/$totalqsos); + addstr($wmain, $y, 16+$len, # Add nr,percentage + $result{$key}.' = '.$percent.'%' ); + print HTML "\n"; + } + print HTML "\n"; + print HTML "\n
$key"; + my $len = int(($result{$key}/$maxqsos)*40); # length of bar + if (($len == "0") and ($result{$key} > 0)) { # at least one + $len = 1; # if QSO was made + } + print HTML "bar$result{$key} = $percent%
Total:$totalqsos = 100%
\n\n\n"; + close HTML; + return 0; } @@ -4790,66 +4790,66 @@ sub statistics { ############################################################################### sub editdb { - my $call = $_[0]; - my $win = ${$_[1]}; - my @nameqth = ('',''); - my @wi; # Windows to edit Name/QTH inside... - my $stat; # Status 1: edit name 2: edit QTH + my $call = $_[0]; + my $win = ${$_[1]}; + my @nameqth = ('',''); + my @wi; # Windows to edit Name/QTH inside... + my $stat; # Status 1: edit name 2: edit QTH addstr($win,0,0, ' 'x(80*22)); # blue background - - my $sth = $dbh->prepare("SELECT `NAME`, `QTH` FROM `calls` WHERE `CALL`= - '$call'"); - $sth->execute(); - @nameqth = $sth->fetchrow_array(); - - unless (defined($nameqth[0]) || defined($nameqth[1])) { - addstr($win, 10, 23, "$call does not exist in the database."); - curs_set(0); - refresh($win); - getch; - curs_set(1); - return 12; - } - addstr($win, 5, 23, "Editing database information for $call"); - addstr($win, 8, 30, "Name:"); - addstr($win, 9, 30, "QTH:"); + + my $sth = $dbh->prepare("SELECT `NAME`, `QTH` FROM `calls` WHERE `CALL`= + '$call'"); + $sth->execute(); + @nameqth = $sth->fetchrow_array(); + + unless (defined($nameqth[0]) || defined($nameqth[1])) { + addstr($win, 10, 23, "$call does not exist in the database."); + curs_set(0); + refresh($win); + getch; + curs_set(1); + return 12; + } + addstr($win, 5, 23, "Editing database information for $call"); + addstr($win, 8, 30, "Name:"); + addstr($win, 9, 30, "QTH:"); refresh($win); - - # Create windows to be be used as editor-windows. - $wi[0] = &makewindow(1,8,9,38,5); - $wi[1] = &makewindow(1,13,10,38,5); - my $wi = \@wi; # reference to windows. - addstr($wi[0], 0,0, $nameqth[0]." "x80); - addstr($wi[1], 0,0, $nameqth[1]." "x80); - refresh($wi[0]);refresh($wi[1]); - - while (1) { # keep editing - $stat = &editdbw($wi, 0, 0, \@nameqth); # EDIT name window - if ($stat == 1) { # main menu - return 2; # $status = 2 -> menu. - } - elsif ($stat == 2) { # &savedbedit - &savedbedit(0,$call,@nameqth); # save - return 12; - } - elsif ($stat == 3) { - &savedbedit(1, $call); # delete - return 12; - } - $stat = &editdbw($wi, 0, 1, \@nameqth); # EDIT QSO window - if ($stat == 1) { # main menu - return 2; # $status = 2 -> menu. - } - elsif ($stat == 2) { # &savedbedit - &savedbedit(0,$call,@nameqth); # save - return 12; - } - elsif ($stat == 3) { - &savedbedit(1, $call); # delete - return 12; - } - } - + + # Create windows to be be used as editor-windows. + $wi[0] = &makewindow(1,8,9,38,5); + $wi[1] = &makewindow(1,13,10,38,5); + my $wi = \@wi; # reference to windows. + addstr($wi[0], 0,0, $nameqth[0]." "x80); + addstr($wi[1], 0,0, $nameqth[1]." "x80); + refresh($wi[0]);refresh($wi[1]); + + while (1) { # keep editing + $stat = &editdbw($wi, 0, 0, \@nameqth); # EDIT name window + if ($stat == 1) { # main menu + return 2; # $status = 2 -> menu. + } + elsif ($stat == 2) { # &savedbedit + &savedbedit(0,$call,@nameqth); # save + return 12; + } + elsif ($stat == 3) { + &savedbedit(1, $call); # delete + return 12; + } + $stat = &editdbw($wi, 0, 1, \@nameqth); # EDIT QSO window + if ($stat == 1) { # main menu + return 2; # $status = 2 -> menu. + } + elsif ($stat == 2) { # &savedbedit + &savedbedit(0,$call,@nameqth); # save + return 12; + } + elsif ($stat == 3) { + &savedbedit(1, $call); # delete + return 12; + } + } + } # end of editdb ############################################################################## @@ -4865,95 +4865,95 @@ sub editdb { ############################################################################## sub editdbw { - my $ch; # the getchar() we read - my $win = ${$_[0]}[$_[2]]; # get window to modify - my $input = ${$_[3]}[$_[2]]; # stores what the user entered, - # init from @qso. - my $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # default match expression - my $pos = 0; # cursor position in the string - move($win,0,0); # move cursor to first position - - # Now the main loop starts which is waiting for any input from the keyboard - # which is stored in $ch. If it is a valid character that matches $match, - # it will be added to the string $input at the proper place. - # - # If an arrow key LEFT or RIGHT is entered, the position within the string - # $input will be changed, considering that it can only be within - # 0..length($input-1). The position is stored in $pos. - # - # If a control character like a F-Key, Enter or Tab is found, the sub - # exists and $input is written to @qso, with attached information on which - # key was pressed, as ||F1 .. ||F10. This way we can switch to the proper - # window when we get back into the main loop. - - while (1) { # loop infinitely - addstr($win,0,0, $input." "x80); # pass $input to window, - # delete all after $input. - move ($win,0,$pos); # move cursor to $pos - refresh($win); # show new window - - $ch = &getch2(); # wait for a character - - - # We first check if it is a legal character of the specified $match, - # if so, it will be added to the string (at the proper position!) - if (($ch =~ /^$match$/)) { # check if it's "legal" - - # The new character will be added to $input at the right place. - $pos++; - $input = substr($input, 0, $pos-1).$ch.substr($input, $pos-1, ); - } - - # The l/r arrow keys change the position of the cursor to left or right - # but only within the boundaries of $input. - - elsif ($ch eq KEY_LEFT) { # arrow left was pressed - if ($pos > 0) { $pos-- } # go left if possible - } - - elsif ($ch eq KEY_RIGHT) { # arrow right was pressed - if ($pos < length($input)) { $pos++ } # go right if possible - } - - elsif (($ch eq KEY_DC) && ($pos < length($input))) { # Delete key - $input = substr($input, 0, $pos).substr($input, $pos+1, ); - } - - elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) - && ($pos > 0)) { - $input = substr($input, 0, $pos-1).substr($input, $pos, ); - $pos--; - } - - # Tab and Enter are the keys to go to the next field, - # if tab or newline is found, the sub puts $input into the - # proper place in the @nameqth array: ${$_[3]}[$_[2]]; - elsif ($ch =~ /^[\t\n]$/) { # Space, Tab or Newline - ${$_[3]}[$_[2]] = $input; # save , return 1 - return 0; - } - # F2 -> save the entry. no validation check made. - elsif ($ch eq KEY_F(2)) { # pressed F2 -> SAVE - ${$_[3]}[$_[2]] = $input; # save field to @nameqth - return 2; - } - - # exit to the MAIN MENU - elsif ($ch eq KEY_F(1)) { - return 1; # -> MENU! - } - - # F3 deletes the current db entry - elsif ($ch eq KEY_F(3)) { # F3 pressed -> delete - return 3; - } - - # QUIT YFKlog - elsif ($ch eq KEY_F(12)) { # QUIT - endwin; # Leave curses mode - exit; - } - } + my $ch; # the getchar() we read + my $win = ${$_[0]}[$_[2]]; # get window to modify + my $input = ${$_[3]}[$_[2]]; # stores what the user entered, + # init from @qso. + my $match = '[\w\d!"$%&/()=?.,;:\-@ ]'; # default match expression + my $pos = 0; # cursor position in the string + move($win,0,0); # move cursor to first position + + # Now the main loop starts which is waiting for any input from the keyboard + # which is stored in $ch. If it is a valid character that matches $match, + # it will be added to the string $input at the proper place. + # + # If an arrow key LEFT or RIGHT is entered, the position within the string + # $input will be changed, considering that it can only be within + # 0..length($input-1). The position is stored in $pos. + # + # If a control character like a F-Key, Enter or Tab is found, the sub + # exists and $input is written to @qso, with attached information on which + # key was pressed, as ||F1 .. ||F10. This way we can switch to the proper + # window when we get back into the main loop. + + while (1) { # loop infinitely + addstr($win,0,0, $input." "x80); # pass $input to window, + # delete all after $input. + move ($win,0,$pos); # move cursor to $pos + refresh($win); # show new window + + $ch = &getch2(); # wait for a character + + + # We first check if it is a legal character of the specified $match, + # if so, it will be added to the string (at the proper position!) + if (($ch =~ /^$match$/)) { # check if it's "legal" + + # The new character will be added to $input at the right place. + $pos++; + $input = substr($input, 0, $pos-1).$ch.substr($input, $pos-1, ); + } + + # The l/r arrow keys change the position of the cursor to left or right + # but only within the boundaries of $input. + + elsif ($ch eq KEY_LEFT) { # arrow left was pressed + if ($pos > 0) { $pos-- } # go left if possible + } + + elsif ($ch eq KEY_RIGHT) { # arrow right was pressed + if ($pos < length($input)) { $pos++ } # go right if possible + } + + elsif (($ch eq KEY_DC) && ($pos < length($input))) { # Delete key + $input = substr($input, 0, $pos).substr($input, $pos+1, ); + } + + elsif ((($ch eq KEY_BACKSPACE) || (ord($ch)==8) || (ord($ch)==0x7F)) + && ($pos > 0)) { + $input = substr($input, 0, $pos-1).substr($input, $pos, ); + $pos--; + } + + # Tab and Enter are the keys to go to the next field, + # if tab or newline is found, the sub puts $input into the + # proper place in the @nameqth array: ${$_[3]}[$_[2]]; + elsif ($ch =~ /^[\t\n]$/) { # Space, Tab or Newline + ${$_[3]}[$_[2]] = $input; # save , return 1 + return 0; + } + # F2 -> save the entry. no validation check made. + elsif ($ch eq KEY_F(2)) { # pressed F2 -> SAVE + ${$_[3]}[$_[2]] = $input; # save field to @nameqth + return 2; + } + + # exit to the MAIN MENU + elsif ($ch eq KEY_F(1)) { + return 1; # -> MENU! + } + + # F3 deletes the current db entry + elsif ($ch eq KEY_F(3)) { # F3 pressed -> delete + return 3; + } + + # QUIT YFKlog + elsif ($ch eq KEY_F(12)) { # QUIT + endwin; # Leave curses mode + exit; + } + } } # &editdbw; @@ -4963,12 +4963,12 @@ sub editdbw { # &savedbedit(1,$call) --> delete entry with "call". ############################################################################### sub savedbedit { - if ($_[0] == 1) { - $dbh->do("delete from `calls` where `CALL` = '$_[1]'") - } - if ($_[0] == 0) { - $dbh->do("update `calls` set `name`='$_[2]', `QTH`='$_[3]' where `call`='$_[1]' "); - } + if ($_[0] == 1) { + $dbh->do("delete from `calls` where `CALL` = '$_[1]'") + } + if ($_[0] == 0) { + $dbh->do("update `calls` set `name`='$_[2]', `QTH`='$_[3]' where `call`='$_[1]' "); + } } ################################################################################ @@ -4981,150 +4981,150 @@ sub savedbedit { ################################################################################ sub lotwimport { - my ($filename, $win) = @_; - my $logs=''; - my $line; - my ($nr, $match, $updated, $nf) = (0,0,0,0); + my ($filename, $win) = @_; + my $logs=''; + my $line; + my ($nr, $match, $updated, $nf) = (0,0,0,0); my @summary; - my ($stncall, $call, $band, $mode, $qsodate, $time, $qslr); # standard - my ($cont, $cqz, $ituz, $iota, $grid, $state, $cnty); # details - # TBD DXCC with ARRL number... - - addstr($win,0,0," "x80); - refresh($win); - - # Check for which calls we can update the database: - my $showtables = "SHOW TABLES"; - - if ($db eq 'sqlite') { - $showtables = "select name from sqlite_master where type='table';" - } - - my $gl = $dbh->prepare($showtables); - $gl->execute(); - - while (my $x = $gl->fetchrow_array()) { - if ($x =~ /log_/) { $logs .= "$x "; } - } - - $logs =~ s/log_//g; - $logs =~ s#_#/#g; # there are now some tables which are not logs, - $logs = uc($logs); # but they will not likely match a callsign... - - open LOG, "$filename"; - - $filename =~ /([^\/]+)$/; - my $basename = $1; - open ERROR, ">/tmp/$mycall-LOTW-update-from-$basename.err"; - - # Only continue if real lotwreport file.. - while ($line = ) { - last if ($line =~ /ARRL Logbook of the World Status Report/) - } - - while ($line = ) { - if ($line =~ /STATION_CALLSIGN:\d+>([A-Z0-9\/]+)/) { - $stncall = $1; - } - elsif ($line =~ /CALL:\d+>([A-Z0-9\/]+)/) { - $call = $1; - } - elsif ($line =~ /BAND:\d+>(\w+)/) { - $band = $1; - } - elsif ($line =~ /MODE:\d+>(\w+)/) { - $mode = $1; - } - elsif ($line =~ /QSO_DATE:\d+>(\d+)/) { - $qsodate = $1; - } - elsif ($line =~ /TIME_ON:\d+>(\d+)/) { - $time = $1; - } - elsif ($line =~ /QSL_RCVD:\d+>([A-Z]+)/) { - $qslr = $1; - } - elsif ($line =~ /CONT:\d+>([A-Z]+)/) { - $cont = $1; - } - elsif ($line =~ /CQZ:\d+>(\d+)/) { - $cqz= $1; - } - elsif ($line =~ /ITUZ:\d+>(\d+)/) { - $ituz= $1; - } - elsif ($line =~ /IOTA:\d+>([A-Z0-9-]+)/) { - $iota= $1; - } - elsif ($line =~ /GRIDSQUARE:\d+>(\w+)/) { - $grid= $1; - } - elsif ($line =~ /STATE:\d+>(\w+)/) { - $state= $1; - } - elsif ($line =~ //) { - addstr($win,0,0,"Updating record $nr... ") if ($nr =~ /0$/); - refresh($win); - $nr++; - if ($qslr =~ /Y/) { # update - # check if a log table exists.. - unless($logs =~ /(^| )$stncall( |$)/) { - $nf++; - print ERROR "$stncall QSO with $call at $qsodate $time". - " on $band / $mode not found in log!\n"; - } - else { - my $update = "QSLRL='Y'"; - - if ($lotwdetails) { - $update .= ", CONT='$cont'" if $cont; - $update .= ", CQZ='$cqz'" if $cqz; - $update .= ", ITUZ='$ituz'" if $ituz; - $update .= ", IOTA='$iota'" if $iota; - $update .= ", GRID='$grid'" if $grid; - $update .= ", STATE='$state'" if $state; - } - - - if ($band =~ /([0-9.]+)cm$/i) { - $band = $1/100; # cm -> m - } - else { - substr($band, -1,) = ''; # remove m - } - - - $qsodate =~ s/(\d{4})(\d{2})(\d{2})/$1-$2-$3/g; - $time =~ s/(\d{2})(\d{2})(\d{2})/$1:$2/g; # cut secs - $stncall =~ s#/#_#g; $stncall = lc($stncall); - - my $rband = 'round(`band`, 4)'; - if ($db eq 'sqlite') { $rband = 'band'; }; - - my $sth = $dbh->prepare("update log_$stncall set $update - where `call`='$call' and $rband = '$band' and - mode='$mode' and date='$qsodate' and t_on like '$time%';"); - - my $rows = $sth->execute(); - - if ($rows == 0) { - print ERROR "$stncall QSO with $call at $qsodate $time". - " on $band / $mode not found in log!\n"; - $nf++; - } - else { - $match++; + my ($stncall, $call, $band, $mode, $qsodate, $time, $qslr); # standard + my ($cont, $cqz, $ituz, $iota, $grid, $state, $cnty); # details + # TBD DXCC with ARRL number... + + addstr($win,0,0," "x80); + refresh($win); + + # Check for which calls we can update the database: + my $showtables = "SHOW TABLES"; + + if ($db eq 'sqlite') { + $showtables = "select name from sqlite_master where type='table';" + } + + my $gl = $dbh->prepare($showtables); + $gl->execute(); + + while (my $x = $gl->fetchrow_array()) { + if ($x =~ /log_/) { $logs .= "$x "; } + } + + $logs =~ s/log_//g; + $logs =~ s#_#/#g; # there are now some tables which are not logs, + $logs = uc($logs); # but they will not likely match a callsign... + + open LOG, "$filename"; + + $filename =~ /([^\/]+)$/; + my $basename = $1; + open ERROR, ">/tmp/$mycall-LOTW-update-from-$basename.err"; + + # Only continue if real lotwreport file.. + while ($line = ) { + last if ($line =~ /ARRL Logbook of the World Status Report/) + } + + while ($line = ) { + if ($line =~ /STATION_CALLSIGN:\d+>([A-Z0-9\/]+)/) { + $stncall = $1; + } + elsif ($line =~ /CALL:\d+>([A-Z0-9\/]+)/) { + $call = $1; + } + elsif ($line =~ /BAND:\d+>(\w+)/) { + $band = $1; + } + elsif ($line =~ /MODE:\d+>(\w+)/) { + $mode = $1; + } + elsif ($line =~ /QSO_DATE:\d+>(\d+)/) { + $qsodate = $1; + } + elsif ($line =~ /TIME_ON:\d+>(\d+)/) { + $time = $1; + } + elsif ($line =~ /QSL_RCVD:\d+>([A-Z]+)/) { + $qslr = $1; + } + elsif ($line =~ /CONT:\d+>([A-Z]+)/) { + $cont = $1; + } + elsif ($line =~ /CQZ:\d+>(\d+)/) { + $cqz= $1; + } + elsif ($line =~ /ITUZ:\d+>(\d+)/) { + $ituz= $1; + } + elsif ($line =~ /IOTA:\d+>([A-Z0-9-]+)/) { + $iota= $1; + } + elsif ($line =~ /GRIDSQUARE:\d+>(\w+)/) { + $grid= $1; + } + elsif ($line =~ /STATE:\d+>(\w+)/) { + $state= $1; + } + elsif ($line =~ //) { + addstr($win,0,0,"Updating record $nr... ") if ($nr =~ /0$/); + refresh($win); + $nr++; + if ($qslr =~ /Y/) { # update + # check if a log table exists.. + unless($logs =~ /(^| )$stncall( |$)/) { + $nf++; + print ERROR "$stncall QSO with $call at $qsodate $time". + " on $band / $mode not found in log!\n"; + } + else { + my $update = "QSLRL='Y'"; + + if ($lotwdetails) { + $update .= ", CONT='$cont'" if $cont; + $update .= ", CQZ='$cqz'" if $cqz; + $update .= ", ITUZ='$ituz'" if $ituz; + $update .= ", IOTA='$iota'" if $iota; + $update .= ", GRID='$grid'" if $grid; + $update .= ", STATE='$state'" if $state; + } + + + if ($band =~ /([0-9.]+)cm$/i) { + $band = $1/100; # cm -> m + } + else { + substr($band, -1,) = ''; # remove m + } + + + $qsodate =~ s/(\d{4})(\d{2})(\d{2})/$1-$2-$3/g; + $time =~ s/(\d{2})(\d{2})(\d{2})/$1:$2/g; # cut secs + $stncall =~ s#/#_#g; $stncall = lc($stncall); + + my $rband = 'round(`band`, 4)'; + if ($db eq 'sqlite') { $rband = 'band'; }; + + my $sth = $dbh->prepare("update log_$stncall set $update + where `call`='$call' and $rband = '$band' and + mode='$mode' and date='$qsodate' and t_on like '$time%';"); + + my $rows = $sth->execute(); + + if ($rows == 0) { + print ERROR "$stncall QSO with $call at $qsodate $time". + " on $band / $mode not found in log!\n"; + $nf++; + } + else { + $match++; push @summary, sprintf("%-3d %-10s %-12s %-4s %-4s %-8s %4s", $match, uc($stncall), $call, $band, $mode, $qsodate, substr($time,0,5)); - } + } - } - } - $stncall=$call=$band=$mode=$qsodate=$time=$qslr= - $cont=$cqz=$ituz=$iota=$grid=$state=$cnty=''; # ;-) - } + } + } + $stncall=$call=$band=$mode=$qsodate=$time=$qslr= + $cont=$cqz=$ituz=$iota=$grid=$state=$cnty=''; # ;-) + } - } #while ($line ..) + } #while ($line ..) close ERROR; @@ -5141,14 +5141,14 @@ return ($nr, $match, $nf, @summary); ############################################################################### sub databaseupgrade { -my $oldversion = "10"; # We assume the worst case, version 0.1.0 +my $oldversion = "10"; # We assume the worst case, version 0.1.0 my $version = $main::yfkver; $version =~ s/[.]//g; -if ($_[0] == 1) { # only if called during normal run.. - erase(); - move(0,0); # for optical reasons. - printw "Reinitializing database...\n"; +if ($_[0] == 1) { # only if called during normal run.. + erase(); + move(0,0); # for optical reasons. + printw "Reinitializing database...\n"; } @@ -5158,67 +5158,67 @@ printw "\n\nUsing '$dbname'\@'$db'. Looking for neccessary databases...\n"; # YFKconfig unless (&tableexists('YFKconfig')) { - $dbh->do("create table YFKconfig - ( `Name` varchar(50), `Value` varchar(50));") or die - "Unable to create Table YFKconfig!"; + $dbh->do("create table YFKconfig + ( `Name` varchar(50), `Value` varchar(50));") or die + "Unable to create Table YFKconfig!"; - $dbh->do("insert into YFKconfig (`Name`, `Value`) VALUES - ('version', '0');") or die "Unable to set". - "version in table YFKconfig!"; + $dbh->do("insert into YFKconfig (`Name`, `Value`) VALUES + ('version', '0');") or die "Unable to set". + "version in table YFKconfig!"; } else { - printw "'YFKconfig' table found...\n"; + printw "'YFKconfig' table found...\n"; } # CALLS unless (&tableexists('calls')) { - open CALLS, "$prefix/share/yfklog/db_calls.sql"; - my @calls = ; - close CALLS; + open CALLS, "$prefix/share/yfklog/db_calls.sql"; + my @calls = ; + close CALLS; - $dbh->do("@calls") or die - "Couldn't create calls table from db_calls.sql"; - printw "Created 'calls' table from db_calls.sql\n"; + $dbh->do("@calls") or die + "Couldn't create calls table from db_calls.sql"; + printw "Created 'calls' table from db_calls.sql\n"; } else { - printw "'calls' table found...\n"; + printw "'calls' table found...\n"; } # CLUBS unless (&tableexists('clubs')) { - open CLUBS, "$prefix/share/yfklog/db_clubs.sql"; - my @clubs = ; - close CLUBS; + open CLUBS, "$prefix/share/yfklog/db_clubs.sql"; + my @clubs = ; + close CLUBS; - $dbh->do("@clubs") or die - "Couldn't create clubs table from db_clubs.sql"; - printw "Created 'clubs' table from db_clubs.sql\n"; + $dbh->do("@clubs") or die + "Couldn't create clubs table from db_clubs.sql"; + printw "Created 'clubs' table from db_clubs.sql\n"; } else { - printw "'clubs' table found...\n"; + printw "'clubs' table found...\n"; } # MYCALL unless (&tableexists("log_$mycall")) { - my $logtable = "$prefix/share/yfklog/db_log.sql"; + my $logtable = "$prefix/share/yfklog/db_log.sql"; - if ($db eq 'sqlite') { $logtable = "$prefix/share/yfklog/db_log.sqlite"; } + if ($db eq 'sqlite') { $logtable = "$prefix/share/yfklog/db_log.sqlite"; } - open LOG, $logtable; - my @log = ; - close LOG; + open LOG, $logtable; + my @log = ; + close LOG; - my $log = "@log"; - $log =~ s/MYCALL/$mycall/g; + my $log = "@log"; + $log =~ s/MYCALL/$mycall/g; - $dbh->do($log) or die - "Couldn't create log table $mycall from $logtable"; - printw "Created log table $mycall from $logtable\n"; + $dbh->do($log) or die + "Couldn't create log table $mycall from $logtable"; + printw "Created log table $mycall from $logtable\n"; } else { - printw "Log table $mycall found...\n"; + printw "Log table $mycall found...\n"; } # Get a list of all logs.... @@ -5228,7 +5228,7 @@ my @logs; my $showtables = "SHOW TABLES;"; if ($db eq 'sqlite') { - $showtables = "select name from sqlite_master where type='table';"; + $showtables = "select name from sqlite_master where type='table';"; } my $gl = $dbh->prepare($showtables); @@ -5236,113 +5236,113 @@ $gl->execute(); my $l; while($l = $gl->fetchrow_array()) { - if ($l =~ /log_/) { - push @logs, $l; - } + if ($l =~ /log_/) { + push @logs, $l; + } } printw "\nChecking Database version.\n"; if (&tableexists('YFKconfig')) { - my $bla = $dbh->prepare("SELECT Value from YFKconfig where - Name = 'version'"); - $bla->execute; - $oldversion = $bla->fetchrow_array(); - printw "DB: $oldversion\n"; - $oldversion =~ s/[.]//g; + my $bla = $dbh->prepare("SELECT Value from YFKconfig where + Name = 'version'"); + $bla->execute; + $oldversion = $bla->fetchrow_array(); + printw "DB: $oldversion\n"; + $oldversion =~ s/[.]//g; } if ($db eq 'sqlite') { $oldversion = 25 unless $oldversion > 25}; -if ($oldversion < 23) { # Update to 0.2.3 database - printw "\nUpdating the Database from Version < 0.2.3.\n\nWhen updating from YFKlog 0.1.0, run 'yfk-fixdxcc.pl'.\n"; +if ($oldversion < 23) { # Update to 0.2.3 database + printw "\nUpdating the Database from Version < 0.2.3.\n\nWhen updating from YFKlog 0.1.0, run 'yfk-fixdxcc.pl'.\n"; - foreach $l (@logs) { - $dbh->do("ALTER TABLE $l MODIFY BAND FLOAT;"); - printw "Updated table $l: band->float"; + foreach $l (@logs) { + $dbh->do("ALTER TABLE $l MODIFY BAND FLOAT;"); + printw "Updated table $l: band->float"; - # MySQL 4 doesn't allow 'WHERE Field=....' yet :-( - my $res = $dbh->prepare("SHOW COLUMNS from $l;"); + # MySQL 4 doesn't allow 'WHERE Field=....' yet :-( + my $res = $dbh->prepare("SHOW COLUMNS from $l;"); - $res->execute(); + $res->execute(); - my $hasqslrl=0; - while (my @tmp = $res->fetchrow_array()) { - if ($tmp[0] =~ /QSLRL/i) { - $hasqslrl=1; - last; - } - } + my $hasqslrl=0; + while (my @tmp = $res->fetchrow_array()) { + if ($tmp[0] =~ /QSLRL/i) { + $hasqslrl=1; + last; + } + } - unless ($hasqslrl) { - $dbh->do("alter table $l add qslrl char(1) not - null default 'N';") or die - "$hasqslrl $l"; - printw ", qslrl added"; - } + unless ($hasqslrl) { + $dbh->do("alter table $l add qslrl char(1) not + null default 'N';") or die + "$hasqslrl $l"; + printw ", qslrl added"; + } - printw ".\n"; - } #foreach log + printw ".\n"; + } #foreach log - # update config table + # update config table - printw "Database upgraded to Version 0.2.3 now.\n"; + printw "Database upgraded to Version 0.2.3 now.\n"; - $oldversion = 23; + $oldversion = 23; } # here we are up to date with YFKlog 0.2.3. # Upgrade from Version 0.2.3 to 0.2.4. Nothing really to do. if ($oldversion < 24) { - $dbh->do("update YFKconfig set `Value` = '0.2.4' where - `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; - printw "Updated DB from 0.2.3 to 0.2.4.\n"; + $dbh->do("update YFKconfig set `Value` = '0.2.4' where + `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; + printw "Updated DB from 0.2.3 to 0.2.4.\n"; } # Upgrade from Version 0.2.4 to 0.2.5. Add fields GRID and OPERATOR. if ($oldversion < 25) { - foreach $l (@logs) { - my $res = $dbh->prepare("SHOW COLUMNS from $l;"); - $res->execute(); - my $hasgrid=0; - my $hasoperator=0; - while (my @tmp = $res->fetchrow_array()) { - if ($tmp[0] =~ /OPERATOR/i) { - $hasoperator = 1; - } - elsif ($tmp[0] =~ /GRID/i) { - $hasgrid = 1; - } - } - - printw "Added fields: "; - unless ($hasgrid) { - $dbh->do("alter table $l add `GRID` varchar(6) not - null default '';") or die "Failed to add GRID to table $l"; - printw " GRID "; - } - unless ($hasoperator) { - $dbh->do("alter table $l add `OPERATOR` varchar(8) not - null default '';") or die "Failed to add OPERATOR to table $l"; - printw " OPERATOR "; - } - printw " (none) " unless ($hasgrid || $hasoperator); - printw "to $l\n"; - - } - $dbh->do("update YFKconfig set `Value` = '0.2.5' where - `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; - printw "Updated DB from 0.2.4 to 0.2.5.\n"; + foreach $l (@logs) { + my $res = $dbh->prepare("SHOW COLUMNS from $l;"); + $res->execute(); + my $hasgrid=0; + my $hasoperator=0; + while (my @tmp = $res->fetchrow_array()) { + if ($tmp[0] =~ /OPERATOR/i) { + $hasoperator = 1; + } + elsif ($tmp[0] =~ /GRID/i) { + $hasgrid = 1; + } + } + + printw "Added fields: "; + unless ($hasgrid) { + $dbh->do("alter table $l add `GRID` varchar(6) not + null default '';") or die "Failed to add GRID to table $l"; + printw " GRID "; + } + unless ($hasoperator) { + $dbh->do("alter table $l add `OPERATOR` varchar(8) not + null default '';") or die "Failed to add OPERATOR to table $l"; + printw " OPERATOR "; + } + printw " (none) " unless ($hasgrid || $hasoperator); + printw "to $l\n"; + + } + $dbh->do("update YFKconfig set `Value` = '0.2.5' where + `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; + printw "Updated DB from 0.2.4 to 0.2.5.\n"; } # Upgrade from Version 0.2.5 to 0.3.5. Nothing really to do. if ($oldversion < 35) { - $dbh->do("update YFKconfig set `Value` = '0.3.5' where - `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; - printw "Updated DB to 0.3.5.\n"; + $dbh->do("update YFKconfig set `Value` = '0.3.5' where + `Name` = 'version';") or die "Unable to set version in table YFKconfig!"; + printw "Updated DB to 0.3.5.\n"; } printw "All up to date!\n\nPress any key to continue.\n"; @@ -5361,60 +5361,60 @@ refresh(); ############################################################################### sub xplanet { - my $modes = "'" . join("','", split(/\s+/, $_[0])) . "'"; # modes to query - my $line; - my %dxcc; # keys: DXCCs, Values: Green=worked, Red=needed - my %lat; # latitides and longitudes for each DXCC - my %lon; - my ($pfx, $lat, $lon); - - open CTY, "$prefix/share/yfklog/cty.dat" or die "Cannot find cty.dat!\n"; - while ($line = ) { - chomp($line); - next unless ($line =~ /^[A-Z]/); # no data lines pse - $line =~ s/ //g; # remove spaces - - $pfx = (split(/:/, $line))[-1]; # DXCC prefix - $lat = (split(/:/, $line))[-4]; # - $lon = (split(/:/, $line))[-3]; # - - - next if (!defined($pfx) || ($pfx =~ /[*]/)); # remove WAEs - $pfx =~ s/\///g; # remove / - - $lat{$pfx} = $lat; - $lon{$pfx} = $lon; - $dxcc{$pfx} = "Red"; - } - close CTY; - - my $sth = $dbh->prepare("SELECT DXCC, QSLR, QSLRL FROM log_$mycall - WHERE MODE in ($modes)"); - $sth->execute() or die "Execute failed!"; - - my ($dx,$qslr, $qslrl); - $sth->bind_columns(\$dx,\$qslr, \$qslrl) or die "Bind failed!"; - - while ($sth->fetch()) { - next unless (defined($dxcc{$dx})); # just in case.. - next if ($dxcc{$dx} eq 'Green'); # already confirmed - if (($qslr eq 'Y') || ($qslrl eq 'Y')) { - $dxcc{$dx} = 'Green'; - } - else { - $dxcc{$dx} = 'Yellow'; - } - } - - open EARTH, ">$directory/$mycall-earth"; - - # special sorting to put green on top of yellow and red - foreach (sort {if ($dxcc{$a} eq 'Red') {return -1;} - elsif ($dxcc{$b} eq 'Red') {return 1;} - else {return $dxcc{$b} cmp $dxcc{$a}}} keys %dxcc) { - print EARTH $lat{$_}." ".(-1*$lon{$_}).' "'.$_.'" color='.$dxcc{$_}."\n"; - } - close EARTH; + my $modes = "'" . join("','", split(/\s+/, $_[0])) . "'"; # modes to query + my $line; + my %dxcc; # keys: DXCCs, Values: Green=worked, Red=needed + my %lat; # latitides and longitudes for each DXCC + my %lon; + my ($pfx, $lat, $lon); + + open CTY, "$prefix/share/yfklog/cty.dat" or die "Cannot find cty.dat!\n"; + while ($line = ) { + chomp($line); + next unless ($line =~ /^[A-Z]/); # no data lines pse + $line =~ s/ //g; # remove spaces + + $pfx = (split(/:/, $line))[-1]; # DXCC prefix + $lat = (split(/:/, $line))[-4]; # + $lon = (split(/:/, $line))[-3]; # + + + next if (!defined($pfx) || ($pfx =~ /[*]/)); # remove WAEs + $pfx =~ s/\///g; # remove / + + $lat{$pfx} = $lat; + $lon{$pfx} = $lon; + $dxcc{$pfx} = "Red"; + } + close CTY; + + my $sth = $dbh->prepare("SELECT DXCC, QSLR, QSLRL FROM log_$mycall + WHERE MODE in ($modes)"); + $sth->execute() or die "Execute failed!"; + + my ($dx,$qslr, $qslrl); + $sth->bind_columns(\$dx,\$qslr, \$qslrl) or die "Bind failed!"; + + while ($sth->fetch()) { + next unless (defined($dxcc{$dx})); # just in case.. + next if ($dxcc{$dx} eq 'Green'); # already confirmed + if (($qslr eq 'Y') || ($qslrl eq 'Y')) { + $dxcc{$dx} = 'Green'; + } + else { + $dxcc{$dx} = 'Yellow'; + } + } + + open EARTH, ">$directory/$mycall-earth"; + + # special sorting to put green on top of yellow and red + foreach (sort {if ($dxcc{$a} eq 'Red') {return -1;} + elsif ($dxcc{$b} eq 'Red') {return 1;} + else {return $dxcc{$b} cmp $dxcc{$a}}} keys %dxcc) { + print EARTH $lat{$_}." ".(-1*$lon{$_}).' "'.$_.'" color='.$dxcc{$_}."\n"; + } + close EARTH; } @@ -5426,34 +5426,34 @@ sub xplanet { sub queryrig { - my ($freq, $mode); + my ($freq, $mode); - my $sock = new IO::Socket::INET ( PeerAddr => 'localhost', - PeerPort => $hamlibtcpport, Proto => 'tcp'); + my $sock = new IO::Socket::INET ( PeerAddr => 'localhost', + PeerPort => $hamlibtcpport, Proto => 'tcp'); - return 0 unless $sock; + return 0 unless $sock; - print $sock "f\n"; - $freq = <$sock>; - chomp($freq); - - print $sock "m\n"; - $mode = <$sock>; - chomp($mode); + print $sock "f\n"; + $freq = <$sock>; + chomp($freq); + + print $sock "m\n"; + $mode = <$sock>; + chomp($mode); - if ($mode eq 'CWR') { - $mode = 'CW'; - } - elsif ($mode eq 'USB' || $mode eq 'LSB') { - $mode = 'SSB'; - } + if ($mode eq 'CWR') { + $mode = 'CW'; + } + elsif ($mode eq 'USB' || $mode eq 'LSB') { + $mode = 'SSB'; + } - $freq = &freq2band($freq/1000); - - ${$_[0]} = $freq; - ${$_[1]} = $mode; + $freq = &freq2band($freq/1000); + + ${$_[0]} = $freq; + ${$_[1]} = $mode; - return 1; # success + return 1; # success } @@ -5462,24 +5462,24 @@ sub queryrig { ############################################################################### sub tableexists { - my $table = shift; + my $table = shift; - my $showtables = "SHOW TABLES FROM $dbname LIKE '$table';"; + my $showtables = "SHOW TABLES FROM $dbname LIKE '$table';"; - if ($db eq 'sqlite') { - $showtables = "select count(*) from sqlite_master where type='table' and ". - "name = '$table';"; - } + if ($db eq 'sqlite') { + $showtables = "select count(*) from sqlite_master where type='table' and ". + "name = '$table';"; + } - my $exists = $dbh->prepare($showtables) or die "Error!"; - $exists->execute(); + my $exists = $dbh->prepare($showtables) or die "Error!"; + $exists->execute(); - if ($exists->fetchrow_array()) { - return 1; - } - else { - return 0; - } + if ($exists->fetchrow_array()) { + return 1; + } + else { + return 0; + } } #tableexists ############################################################################### @@ -5487,27 +5487,27 @@ sub tableexists { ############################################################################### sub changeconfig { - open CONFIG, "$ENV{HOME}/.yfklog/config" or die "Can't find config file!\n"; - my @cfg = ; - my $changed=0; - close CONFIG; - - foreach (@cfg) { - if ($_ =~ s/$_[0]/$_[1]/i) { - $changed = 1; - } - } + open CONFIG, "$ENV{HOME}/.yfklog/config" or die "Can't find config file!\n"; + my @cfg = ; + my $changed=0; + close CONFIG; + + foreach (@cfg) { + if ($_ =~ s/$_[0]/$_[1]/i) { + $changed = 1; + } + } - # If the value wasn't defined in the config file before, it must be added. + # If the value wasn't defined in the config file before, it must be added. - unless ($changed) { - push(@cfg, "# Added by YFKlog:\n"); - push(@cfg, $_[1]."\n"); - } + unless ($changed) { + push(@cfg, "# Added by YFKlog:\n"); + push(@cfg, $_[1]."\n"); + } - open CONFIG, ">$ENV{HOME}/.yfklog/config" or die "Can't write to config!\n"; - print CONFIG @cfg; - close CONFIG; + open CONFIG, ">$ENV{HOME}/.yfklog/config" or die "Can't write to config!\n"; + print CONFIG @cfg; + close CONFIG; } @@ -5517,42 +5517,42 @@ sub changeconfig { ############################################################################### sub jumpfield { - my $current = $_[0]; # current field (1..14, fixed order) - my $direction = $_[1]; # may be 'n' for next or 'p' for previous - my $nextfieldname = 'CALL'; - - # representation of the fields in the program - my @fields = ('NULL', 'CALL', 'DATE', 'TON', 'TOFF', 'BAND', - 'MODE', 'QTH', 'NAME', 'QSLS', 'QSLR', - 'RSTS', 'RSTR', 'REM', 'PWR'); - - my %fields = ('CALL' => 1, 'DATE' => 2, 'TON' => 3, 'TOFF' => 4, 'BAND' =>5, - 'MODE'=> 6, 'QTH' => 7, 'NAME' => 8, 'QSLS' => 9, 'QSLR' => 10, - 'RSTS' => 11, 'RSTR' => 12, 'REM' => 13, 'PWR' => 14); - - # @fieldorder = ('CALL', 'DATE'...); - - my $currentfield = $fields[$current]; # Name of the current field. - - for (0..$#fieldorder) { - if ($fieldorder[$_] eq $currentfield) { - if ($direction eq 'n') { - if (defined($fieldorder[$_+1])) { - $nextfieldname = $fieldorder[$_+1]; - } - else { - $nextfieldname = $fieldorder[0]; - } - } - else { - $nextfieldname = $fieldorder[$_-1]; #negative index -> last el - } - - } - } - - # convert to a field number - return $fields{$nextfieldname}; + my $current = $_[0]; # current field (1..14, fixed order) + my $direction = $_[1]; # may be 'n' for next or 'p' for previous + my $nextfieldname = 'CALL'; + + # representation of the fields in the program + my @fields = ('NULL', 'CALL', 'DATE', 'TON', 'TOFF', 'BAND', + 'MODE', 'QTH', 'NAME', 'QSLS', 'QSLR', + 'RSTS', 'RSTR', 'REM', 'PWR'); + + my %fields = ('CALL' => 1, 'DATE' => 2, 'TON' => 3, 'TOFF' => 4, 'BAND' =>5, + 'MODE'=> 6, 'QTH' => 7, 'NAME' => 8, 'QSLS' => 9, 'QSLR' => 10, + 'RSTS' => 11, 'RSTR' => 12, 'REM' => 13, 'PWR' => 14); + + # @fieldorder = ('CALL', 'DATE'...); + + my $currentfield = $fields[$current]; # Name of the current field. + + for (0..$#fieldorder) { + if ($fieldorder[$_] eq $currentfield) { + if ($direction eq 'n') { + if (defined($fieldorder[$_+1])) { + $nextfieldname = $fieldorder[$_+1]; + } + else { + $nextfieldname = $fieldorder[0]; + } + } + else { + $nextfieldname = $fieldorder[$_-1]; #negative index -> last el + } + + } + } + + # convert to a field number + return $fields{$nextfieldname}; } @@ -5560,26 +5560,26 @@ sub jumpfield { # Asks for a confirmation in a new window, at the bottom of the screen. sub askconfirmation { - my $k; - my ($question, $regex) = @_; - my $win = &makewindow(1,80,$main::row-1,0,6); + my $k; + my ($question, $regex) = @_; + my $win = &makewindow(1,80,$main::row-1,0,6); - curs_set(0); + curs_set(0); - addstr($win, 0, 0, $question." "x80); - refresh($win); - do { - $k = getch(); - } until ($k =~ /$regex/i); + addstr($win, 0, 0, $question." "x80); + refresh($win); + do { + $k = getch(); + } until ($k =~ /$regex/i); - delwin($win); + delwin($win); - touchwin($main::whelp); - refresh($main::whelp); - - curs_set(1); + touchwin($main::whelp); + refresh($main::whelp); + + curs_set(1); - return $k; + return $k; } @@ -5590,95 +5590,95 @@ sub askconfirmation { # output: error message why the QSO is invalid, in a window at the bottom sub finderror { - my @qso = @_; - my $err; - my $mode = 'log'; - - unless (&wpx($qso[0])) { - $err .= "Call (doesn't have a valid prefix), "; - } - - unless ((length($qso[1]) == 8) && - (substr($qso[1],0,2) < 32) && - (substr($qso[1],2,2) < 13) && - (substr($qso[1],4,) > 1900)) { - $err .= "Date (format: DDMMYYYY), "; - } - - unless ((length($qso[2]) == 4) && - (substr($qso[2],0,2) < 24) && - (substr($qso[2],3,2) < 60)) { - $err .= "Time on (HHMM), "; - } - - if ($qso[3] eq '') { $qso[3] = 1212 }; - unless ((length($qso[3]) == 4) && - (substr($qso[3],0,2) < 24) && - (substr($qso[3],3,2) < 60)) { - $err .= "Time off (HHMM), "; - } - - if ($qso[4] eq '' || $qso[4] =~ /^[.]*$/) { - $err .= "Band (must not be empty), "; - } - - if ($qso[5] eq '') { - $err .= "Mode (must not be empty), "; - } - - if ($qso[8] eq '') { - $err .= "QSLs (must not be empty), "; - } - - if ($qso[9] eq '') { - $err .= "QSLr (must not be empty), "; - } - - # When called from updateqso, we have a few more values to check. - if (defined($qso[16])) { - $mode = 'edit'; - - unless ($qso[16] =~ /^(AS|EU|AF|NA|SA|OC|AN)$/) { - $err .= "Continent (must AS, EU, AF, NA, SA, OC, AN), "; - } - - unless (($qso[17] > 0) && ($qso[17] < 91)) { - $err .= "ITU Zone (1-90), "; - } - - unless (($qso[18] > 0) && ($qso[18] < 41)) { - $err .= "CQ Zone (1-40), "; - } - - unless ($qso[20] =~ /(^$qso[16]-\d\d\d$)|(^$)/) { - $err .= "IOTA (format: XX-nnn), "; - } - - unless ($qso[21] =~ /^([A-Z]{1,2})?$/) { - $err .= "State (format: XX), "; - } - - } - - my $win = &makewindow(8,80,7,0,6); - addstr($win, 0, 0, " "x500); - addstr($win, 0, 0, "Error! Following fields have invalid values:"); - addstr($win, 2, 0, "$err QSO cannot be saved. Press any key to go back to the QSO.."); - curs_set(0); - refresh($win); - getch; - delwin($win); - - if ($mode eq 'log') { - touchwin($main::wlog); - refresh($main::wlog); - } - else { - touchwin($main::weditlog); - refresh($main::weditlog); - } - curs_set(1); - + my @qso = @_; + my $err; + my $mode = 'log'; + + unless (&wpx($qso[0])) { + $err .= "Call (doesn't have a valid prefix), "; + } + + unless ((length($qso[1]) == 8) && + (substr($qso[1],0,2) < 32) && + (substr($qso[1],2,2) < 13) && + (substr($qso[1],4,) > 1900)) { + $err .= "Date (format: DDMMYYYY), "; + } + + unless ((length($qso[2]) == 4) && + (substr($qso[2],0,2) < 24) && + (substr($qso[2],3,2) < 60)) { + $err .= "Time on (HHMM), "; + } + + if ($qso[3] eq '') { $qso[3] = 1212 }; + unless ((length($qso[3]) == 4) && + (substr($qso[3],0,2) < 24) && + (substr($qso[3],3,2) < 60)) { + $err .= "Time off (HHMM), "; + } + + if ($qso[4] eq '' || $qso[4] =~ /^[.]*$/) { + $err .= "Band (must not be empty), "; + } + + if ($qso[5] eq '') { + $err .= "Mode (must not be empty), "; + } + + if ($qso[8] eq '') { + $err .= "QSLs (must not be empty), "; + } + + if ($qso[9] eq '') { + $err .= "QSLr (must not be empty), "; + } + + # When called from updateqso, we have a few more values to check. + if (defined($qso[16])) { + $mode = 'edit'; + + unless ($qso[16] =~ /^(AS|EU|AF|NA|SA|OC|AN)$/) { + $err .= "Continent (must AS, EU, AF, NA, SA, OC, AN), "; + } + + unless (($qso[17] > 0) && ($qso[17] < 91)) { + $err .= "ITU Zone (1-90), "; + } + + unless (($qso[18] > 0) && ($qso[18] < 41)) { + $err .= "CQ Zone (1-40), "; + } + + unless ($qso[20] =~ /(^$qso[16]-\d\d\d$)|(^$)/) { + $err .= "IOTA (format: XX-nnn), "; + } + + unless ($qso[21] =~ /^([A-Z]{1,2})?$/) { + $err .= "State (format: XX), "; + } + + } + + my $win = &makewindow(8,80,7,0,6); + addstr($win, 0, 0, " "x500); + addstr($win, 0, 0, "Error! Following fields have invalid values:"); + addstr($win, 2, 0, "$err QSO cannot be saved. Press any key to go back to the QSO.."); + curs_set(0); + refresh($win); + getch; + delwin($win); + + if ($mode eq 'log') { + touchwin($main::wlog); + refresh($main::wlog); + } + else { + touchwin($main::weditlog); + refresh($main::weditlog); + } + curs_set(1); + } ############################################################################### @@ -5688,171 +5688,171 @@ sub finderror { sub receive_qso { my @qso; my %month = ('Jan' => '01', 'Feb' => '02', 'Mar' => '03', 'Apr' => '04', 'May' - => '05', 'Jun' => '06', 'Jul' => '07', 'Aug' => '08', 'Sep' => '09', - 'Oct' => '10', 'Nov' => '11', 'Dec' => '12'); + => '05', 'Jun' => '06', 'Jul' => '07', 'Aug' => '08', 'Sep' => '09', + 'Oct' => '10', 'Nov' => '11', 'Dec' => '12'); my $id = msgget(1238, 0666 | IPC_CREAT); if (msgrcv($id, my $rcvd, 1024, 0, 0 | IPC_NOWAIT)) { - msgctl ($id, IPC_RMID, 0); - substr($rcvd, 0, 4) = ''; - my @rx = split(chr(1), $rcvd); - - my %qh = (); - foreach (@rx) { - my ($key, $value) = split(/:/, $_); - $qh{$key} = $value if($value); - } - - # See which values we have, fill the others with defaults. Minimum required - # is a callsign, the rest can be defaults. - - if (defined($qh{call})) { - $qso[0] = uc($qh{call}); - } - else { - return 0; - } - - if (defined($qh{date})) { - my @k = split(/\s+/, $qh{date}); - $qso[1] = $k[0].$month{$k[1]}.$k[2]; - } - else { - $qso[1] = &getdate(); - } - - if (defined($qh{time})) { - $qso[2] = $qh{time}; - } - else { - $qso[2] = &gettime; - } - - if (defined($qh{endtime})) { - $qso[3] = $qh{endtime}; - } - else { - $qso[3] = &gettime; - } - - if (defined($qh{mhz})) { - if ($qh{mhz} eq 'HAMLIB') { - my ($freq, $mode); - &queryrig(\$freq, \$mode); - $qso[4] = &freq2band($freq); - } - else { - $qso[4] = &freq2band(1000*$qh{mhz}); - } - } - else { - $qso[4] = $dband; - } - - if ($qso[4] == 0) { - $qso[4] = $dband; - } - - if (defined($qh{mode})) { - $qso[5] = $qh{mode}; - $qso[5] =~ s/^BPSK/PSK/g; - } - else { - $qso[5] = $dmode; - } - - if (defined($qh{tx})) { - $qso[10] = $qh{tx}; - $qso[10] =~ s/[^0-9]//g; - } - else { - $qso[10] = '599'; - } - - if (defined($qh{rx})) { - $qso[11] = $qh{rx}; - $qso[11] =~ s/[^0-9]//g; - } - else { - $qso[11] = '599'; - } - - if (defined($qh{name})) { - $qso[7] = $qh{name}; - if (length($qso[7]) > 15) { - substr($qso[7], 15, ) = ''; - } - } - else { - $qso[7] = ''; - } - - if (defined($qh{qth})) { - $qso[6] = $qh{qth}; - if (length($qso[6]) > 15) { - substr($qso[6], 15, ) = ''; - } - } - else { - $qso[6] = ''; - } - - if (defined($qh{notes})) { - $qso[12] = $qh{notes}; - if (length($qso[12]) > 60) { - substr($qso[12], 60, ) = ''; - } - } - else { - $qso[12] = ''; - } - - if (defined($qh{power})) { - $qso[13] = $qh{power}; - } - else { - $qso[13] = $dpwr; - } - - if (defined($qh{locator})) { - $qso[12] .= "GRID:\U$qh{locator} "; - } - - $qso[8] = $dqsls; - $qso[9] = 'N'; - - if (&saveqso(@qso)) { - return "Received QSO ($qso[0]) from $qh{program}. "; - } - else { - return "Error: Received invalid QSO."; - } + msgctl ($id, IPC_RMID, 0); + substr($rcvd, 0, 4) = ''; + my @rx = split(chr(1), $rcvd); + + my %qh = (); + foreach (@rx) { + my ($key, $value) = split(/:/, $_); + $qh{$key} = $value if($value); + } + + # See which values we have, fill the others with defaults. Minimum required + # is a callsign, the rest can be defaults. + + if (defined($qh{call})) { + $qso[0] = uc($qh{call}); + } + else { + return 0; + } + + if (defined($qh{date})) { + my @k = split(/\s+/, $qh{date}); + $qso[1] = $k[0].$month{$k[1]}.$k[2]; + } + else { + $qso[1] = &getdate(); + } + + if (defined($qh{time})) { + $qso[2] = $qh{time}; + } + else { + $qso[2] = &gettime; + } + + if (defined($qh{endtime})) { + $qso[3] = $qh{endtime}; + } + else { + $qso[3] = &gettime; + } + + if (defined($qh{mhz})) { + if ($qh{mhz} eq 'HAMLIB') { + my ($freq, $mode); + &queryrig(\$freq, \$mode); + $qso[4] = &freq2band($freq); + } + else { + $qso[4] = &freq2band(1000*$qh{mhz}); + } + } + else { + $qso[4] = $dband; + } + + if ($qso[4] == 0) { + $qso[4] = $dband; + } + + if (defined($qh{mode})) { + $qso[5] = $qh{mode}; + $qso[5] =~ s/^BPSK/PSK/g; + } + else { + $qso[5] = $dmode; + } + + if (defined($qh{tx})) { + $qso[10] = $qh{tx}; + $qso[10] =~ s/[^0-9]//g; + } + else { + $qso[10] = '599'; + } + + if (defined($qh{rx})) { + $qso[11] = $qh{rx}; + $qso[11] =~ s/[^0-9]//g; + } + else { + $qso[11] = '599'; + } + + if (defined($qh{name})) { + $qso[7] = $qh{name}; + if (length($qso[7]) > 15) { + substr($qso[7], 15, ) = ''; + } + } + else { + $qso[7] = ''; + } + + if (defined($qh{qth})) { + $qso[6] = $qh{qth}; + if (length($qso[6]) > 15) { + substr($qso[6], 15, ) = ''; + } + } + else { + $qso[6] = ''; + } + + if (defined($qh{notes})) { + $qso[12] = $qh{notes}; + if (length($qso[12]) > 60) { + substr($qso[12], 60, ) = ''; + } + } + else { + $qso[12] = ''; + } + + if (defined($qh{power})) { + $qso[13] = $qh{power}; + } + else { + $qso[13] = $dpwr; + } + + if (defined($qh{locator})) { + $qso[12] .= "GRID:\U$qh{locator} "; + } + + $qso[8] = $dqsls; + $qso[9] = 'N'; + + if (&saveqso(@qso)) { + return "Received QSO ($qso[0]) from $qh{program}. "; + } + else { + return "Error: Received invalid QSO."; + } } - return 0; + return 0; } sub freq2band { - my $freq = shift; - - if (($freq >= 1800) && ($freq <= 2000)) { $freq = "160"; } - elsif (($freq >= 3500) && ($freq <= 4000)) { $freq = "80"; } - elsif (($freq >= 7000) && ($freq <= 7300)) { $freq = "40"; } - elsif (($freq >=10100) && ($freq <=10150)) { $freq = "30"; } - elsif (($freq >=14000) && ($freq <=14350)) { $freq = "20"; } - elsif (($freq >=18068) && ($freq <=18168)) { $freq = "17"; } - elsif (($freq >=21000) && ($freq <=21450)) { $freq = "15"; } - elsif (($freq >=24890) && ($freq <=24990)) { $freq = "12"; } - elsif (($freq >=28000) && ($freq <=29700)) { $freq = "10"; } - elsif (($freq >=50000) && ($freq <=54000)) { $freq = "6"; } - elsif (($freq >=144000) && ($freq <=148000)) { $freq = "2"; } - else { - $freq = 0; - } - - return $freq; + my $freq = shift; + + if (($freq >= 1800) && ($freq <= 2000)) { $freq = "160"; } + elsif (($freq >= 3500) && ($freq <= 4000)) { $freq = "80"; } + elsif (($freq >= 7000) && ($freq <= 7300)) { $freq = "40"; } + elsif (($freq >=10100) && ($freq <=10150)) { $freq = "30"; } + elsif (($freq >=14000) && ($freq <=14350)) { $freq = "20"; } + elsif (($freq >=18068) && ($freq <=18168)) { $freq = "17"; } + elsif (($freq >=21000) && ($freq <=21450)) { $freq = "15"; } + elsif (($freq >=24890) && ($freq <=24990)) { $freq = "12"; } + elsif (($freq >=28000) && ($freq <=29700)) { $freq = "10"; } + elsif (($freq >=50000) && ($freq <=54000)) { $freq = "6"; } + elsif (($freq >=144000) && ($freq <=148000)) { $freq = "2"; } + else { + $freq = 0; + } + + return $freq; } @@ -5861,59 +5861,59 @@ sub freq2band { # ############################################################################### sub qslstatistics { - my $win = $_[0]; - my ($total, $sent, $received, $queued, $lotwsent, $lotwreceived); - my ($rate, $lotwrate, $call); - - $call = lc($mycall); - - my $qsl = $dbh->prepare("SELECT count(*) from log_$call"); - $qsl->execute; - $total = $qsl->fetchrow_array(); - $qsl = $dbh->prepare("SELECT count(*) from log_$call where qsls = 'Y'"); - $qsl->execute; - $sent = $qsl->fetchrow_array(); - $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslr = 'Y'"); - $qsl->execute; - $received = $qsl->fetchrow_array(); - $qsl = $dbh->prepare("SELECT count(*) from log_$call where qsls = 'Q'"); - $qsl->execute; - $queued = $qsl->fetchrow_array(); - $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslrl= 'R'"); - $qsl->execute; - $lotwsent = $qsl->fetchrow_array(); - $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslrl= 'Y'"); - $qsl->execute; - $lotwreceived = $qsl->fetchrow_array(); - - $lotwsent += $lotwreceived; - - if ($sent) { - $rate = int(1000 * $received / $sent); - } - else { - $rate = 0; - } - if ($lotwsent) { - $lotwrate = int (1000* $lotwreceived / $lotwsent); - } - else { - $lotwrate = 0; - } - - addstr($win, 7, 25, " QSL LOTW"); - addstr($win, 8, 25, "--------------------------"); - addstr($win, 9, 25, sprintf("sent %6d %6d ", $sent, - $lotwsent)); - addstr($win, 10, 25, sprintf("rcvd %6d %6d ", - $received, $lotwreceived)); - addstr($win, 11, 25, sprintf("queued %6d ", $queued)); - addstr($win, 12, 25, sprintf("--------------------------")); - addstr($win, 13,25, sprintf("Rate %4s%% %4s%%", $rate/10, - $lotwrate/10)); - - - refresh($win); + my $win = $_[0]; + my ($total, $sent, $received, $queued, $lotwsent, $lotwreceived); + my ($rate, $lotwrate, $call); + + $call = lc($mycall); + + my $qsl = $dbh->prepare("SELECT count(*) from log_$call"); + $qsl->execute; + $total = $qsl->fetchrow_array(); + $qsl = $dbh->prepare("SELECT count(*) from log_$call where qsls = 'Y'"); + $qsl->execute; + $sent = $qsl->fetchrow_array(); + $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslr = 'Y'"); + $qsl->execute; + $received = $qsl->fetchrow_array(); + $qsl = $dbh->prepare("SELECT count(*) from log_$call where qsls = 'Q'"); + $qsl->execute; + $queued = $qsl->fetchrow_array(); + $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslrl= 'R'"); + $qsl->execute; + $lotwsent = $qsl->fetchrow_array(); + $qsl = $dbh->prepare("SELECT count(*) from log_$call where qslrl= 'Y'"); + $qsl->execute; + $lotwreceived = $qsl->fetchrow_array(); + + $lotwsent += $lotwreceived; + + if ($sent) { + $rate = int(1000 * $received / $sent); + } + else { + $rate = 0; + } + if ($lotwsent) { + $lotwrate = int (1000* $lotwreceived / $lotwsent); + } + else { + $lotwrate = 0; + } + + addstr($win, 7, 25, " QSL LOTW"); + addstr($win, 8, 25, "--------------------------"); + addstr($win, 9, 25, sprintf("sent %6d %6d ", $sent, + $lotwsent)); + addstr($win, 10, 25, sprintf("rcvd %6d %6d ", + $received, $lotwreceived)); + addstr($win, 11, 25, sprintf("queued %6d ", $queued)); + addstr($win, 12, 25, sprintf("--------------------------")); + addstr($win, 13,25, sprintf("Rate %4s%% %4s%%", $rate/10, + $lotwrate/10)); + + + refresh($win); } @@ -5923,26 +5923,26 @@ sub qslstatistics { sub getch2 { - my $ch = getch(); - - # ESC-n instead of F-Keys - if (ord($ch) == 27) { - $ch = getch(); - # Double ESC is like F3 - if (ord($ch) == 27) { - $ch = KEY_F(3); - } - elsif ($ch =~ /^\d$/) { - if ($ch eq '0') { - $ch = KEY_F(10); - } - else { - $ch = KEY_F($ch); - } - } - } - - return $ch; + my $ch = getch(); + + # ESC-n instead of F-Keys + if (ord($ch) == 27) { + $ch = getch(); + # Double ESC is like F3 + if (ord($ch) == 27) { + $ch = KEY_F(3); + } + elsif ($ch =~ /^\d$/) { + if ($ch eq '0') { + $ch = KEY_F(10); + } + else { + $ch = KEY_F($ch); + } + } + } + + return $ch; } sub tqslsign { @@ -5976,9 +5976,9 @@ sub getlotwlocations { # in the current log. the next download should # start at this date. sub getlotwstartdate { - my $query = $dbh->prepare("SELECT date from log_$mycall where qslrl='Y' order by date desc limit 1"); - $query->execute; - my $date = $query->fetchrow_array(); + my $query = $dbh->prepare("SELECT date from log_$mycall where qslrl='Y' order by date desc limit 1"); + $query->execute; + my $date = $query->fetchrow_array(); if ($date) { return $date;