YFKlog Perl Ham Radio logger: https://fkurz.net/ham/yfklog.html
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
5605 lines
178 KiB
5605 lines
178 KiB
#!/usr/bin/perl -w |
|
|
|
# identation looks best with tw=4 |
|
|
|
# Several subroutines for yfklog, a amateur radio logbook software |
|
# |
|
# Copyright (C) 2005-2007 Fabian Kurz, DJ1YFK |
|
# |
|
# This program is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# This program is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with this program; if not, write to the |
|
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
# Boston, MA 02111-1307, USA. |
|
|
|
package yfksubs; |
|
|
|
require Exporter; |
|
@ISA = qw(Exporter); |
|
|
|
@EXPORT = qw( wpx dxcc makewindow clearinputfields qsotofields saveqso readw |
|
lastqsos callinfo getdate gettime splashscreen choseqso getqso chosepqso |
|
entrymask fkeyline winfomask selectlist askbox toggleqsl onlinelog |
|
preparelabels labeltex emptyqslqueue adifexport ftpupload adifimport getlogs |
|
changemycall newlogtable oldlogtable choseeditqso geteditqso editw updateqso checkdate |
|
awards statistics qslstatistics editdb editdbw savedbedit lotwimport |
|
databaseupgrade xplanet queryrig tableexists changeconfig readsubconfig |
|
connectdb connectrig jumpfield receive_qso); |
|
|
|
use strict; |
|
use POSIX; # needed for acos in distance/direction calculation |
|
use Curses; |
|
use Net::FTP; |
|
use IO::Socket; |
|
use DBI; |
|
use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_CREAT); |
|
|
|
my $havehamdb = eval "require Ham::Callsign::DB;"; |
|
my $hamdb; |
|
if ($havehamdb) { |
|
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 |
|
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 $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. |
|
'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="A"; # Order of prev. QSOs |
|
our $browser='dillo'; |
|
our $hamlibtcpport = 4532; |
|
|
|
# We read the configuration file .yfklog. |
|
|
|
sub readsubconfig { |
|
|
|
unless (-e "$ENV{HOME}/.yfklog/config") { return 0 }; |
|
|
|
open CONFIG, "$ENV{HOME}/.yfklog/config" or die "Cannot open configuration file. Error: $!"; |
|
|
|
while (defined (my $line = <CONFIG>)) { # Read line into $line |
|
if ($line =~ /^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 =~ /^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; |
|
} |
|
} |
|
close CONFIG; # Configuration read. |
|
|
|
return 1; |
|
|
|
} #readsubconfig |
|
|
|
# Only open Database when config file was read. |
|
if (&readsubconfig()) { |
|
&connectdb; |
|
&connectrig; |
|
} |
|
|
|
## We connect to the Database now... |
|
|
|
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; |
|
} |
|
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; |
|
} |
|
} |
|
|
|
|
|
# Open Rig for Hamlib |
|
|
|
sub connectrig { |
|
|
|
|
|
} |
|
|
|
|
|
# Now we read cty.dat from K1EA, or exit when it's not found. |
|
my $ctydat = "$prefix/share/yfklog/cty.dat"; |
|
if (-R "./cty.dat") { |
|
$ctydat = "./cty.dat"; |
|
} |
|
|
|
open CTY, "$ctydat" or die "$ctydat not found.". |
|
"Please download it from http://country-files.com/\n"; |
|
|
|
my %prefixes; # hash of arrays main prefix -> (all, prefixes,..) |
|
my %dxcc; # hash of arrays main prefix -> (CQZ, ITUZ, ...) |
|
my $mainprefix; |
|
|
|
while (my $line = <CTY>) { |
|
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; |
|
unless (defined($prefixes{$mainprefix}[0])) { |
|
@{$prefixes{$mainprefix}} = split(/,|;/, $line); |
|
} |
|
else { |
|
push(@{$prefixes{$mainprefix}}, split(/,|;/, $line)); |
|
} |
|
} |
|
} |
|
|
|
close CTY; |
|
|
|
|
|
############################################################################### |
|
# |
|
# &wpx derives the Prefix following WPX rules from a call. These can be found |
|
# at: http://www.cq-amateur-radio.com/wpxrules.html |
|
# e.g. DJ1YFK/TF3 can be counted as both DJ1 or TF3, but this sub does |
|
# not ask for that, always TF3 (= the attached prefix) is returned. If that is |
|
# not want the OP wanted, it can still be modified manually. |
|
# |
|
############################################################################### |
|
|
|
sub wpx { |
|
my ($call, $prefix,$a,$b,$c); |
|
$call = uc(shift); |
|
|
|
# First check if the call is in the proper format, A/B/C where A and C |
|
# are optional (prefix of guest country and P, MM, AM etc) and B is the |
|
# callsign. Only letters, figures and "/" is accepted, no further check if the |
|
# callsign "makes sense". |
|
# 23.Apr.06: Added another "/X" to the regex, for calls like RV0AL/0/P |
|
# as used by RDA-DXpeditions.... |
|
|
|
if ($call =~ |
|
/^((\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 |
|
# lost in further Regex evaluations. |
|
|
|
($a, $b, $c) = ($1, $3, $5); |
|
if ($a) { chop $a }; # Remove the / at the end |
|
if ($c) { $c = substr($c,1,)}; # Remove the / at the beginning |
|
|
|
# In some cases when there is no part A but B and C, and C is longer than 2 |
|
# letters, it happens that $a and $b get the values that $b and $c should |
|
# have. This often happens with liddish callsign-additions like /QRP and |
|
# /LGT, but also with calls like DJ1YFK/KP5. ~/.yfklog has a line called |
|
# "lidadditions", which has QRP and LGT as defaults. This sorts out half of |
|
# the problem, but not calls like DJ1YFK/KH5. This is tested in a second |
|
# try: $a looks like a call (.\d[A-Z]) and $b doesn't (.\d), they are |
|
# swapped. This still does not properly handle calls like DJ1YFK/KH7K where |
|
# only the OP's experience says that it's DJ1YFK on KH7K. |
|
|
|
if (!$c && $a && $b) { # $a and $b exist, no $c |
|
if ($b =~ /$lidadditions/) { # check if $b is a lid-addition |
|
$b = $a; $a = undef; # $a goes to $b, delete lid-add |
|
} |
|
elsif (($a =~ /\d[A-Z]+$/) && ($b =~ /\d$/)) { # check for call in $a |
|
} |
|
} |
|
|
|
# *** 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 |
|
} |
|
|
|
# Depending on these values we have to determine the prefix. |
|
# Following cases are possible: |
|
# |
|
# 1. $a and $c undef --> only callsign, subcases |
|
# 1.1 $b contains a number -> everything from start to number |
|
# 1.2 $b contains no number -> first two letters plus 0 |
|
# 2. $a undef, subcases: |
|
# 2.1 $c is only a number -> $a with changed number |
|
# 2.2 $c is /P,/M,/MM,/AM -> 1. |
|
# 2.3 $c is something else and will be interpreted as a Prefix |
|
# 3. $a is defined, will be taken as PFX, regardless of $c |
|
|
|
if ((not defined $a) && (not defined $c)) { # Case 1 |
|
if ($b =~ /\d/) { # Case 1.1, contains number |
|
$b =~ /(.+\d)[A-Z]*/; # Prefix is all but the last |
|
$prefix = $1; # Letters |
|
} |
|
else { # Case 1.2, no number |
|
$prefix = substr($b,0,2) . "0"; # first two + 0 |
|
} |
|
} |
|
elsif ((not defined $a) && (defined $c)) { # Case 2, CALL/X |
|
if ($c =~ /^(\d)$/) { # Case 2.1, number |
|
$b =~ /(.+\d)[A-Z]*/; # regular Prefix in $1 |
|
# Here we need to find out how many digits there are in the |
|
# prefix, because for example A45XR/0 is A40. If there are 2 |
|
# numbers, the first is not deleted. If course in exotic cases |
|
# like N66A/7 -> N7 this brings the wrong result of N67, but I |
|
# think that's rather irrelevant cos such calls rarely appear |
|
# and if they do, it's very unlikely for them to have a number |
|
# attached. You can still edit it by hand anyway.. |
|
if ($1 =~ /^([A-Z]\d)\d$/) { # e.g. A45 $c = 0 |
|
$prefix = $1 . $c; # -> A40 |
|
} |
|
else { # Otherwise cut all numbers |
|
$1 =~ /(.*[A-Z])\d+/; # Prefix w/o number in $1 |
|
$prefix = $1 . $c;} # Add attached number |
|
} |
|
elsif ($c =~ /$csadditions/) { |
|
$b =~ /(.+\d)[A-Z]*/; # Known attachment -> like Case 1.1 |
|
$prefix = $1; |
|
} |
|
elsif ($c =~ /^\d\d+$/) { # more than 2 numbers -> ignore |
|
$b =~ /(.+\d)[A-Z]*/; # see above |
|
$prefix = $1; |
|
} |
|
else { # Must be a Prefix! |
|
if ($c =~ /\d$/) { # ends in number -> good prefix |
|
$prefix = $c; |
|
} |
|
else { # Add Zero at the end |
|
$prefix = $c . "0"; |
|
} |
|
} |
|
} |
|
elsif (defined $a) { # $a contains the prefix we want |
|
if ($a =~ /\d$/) { # ends in number -> good prefix |
|
$prefix = $a |
|
} |
|
else { # add zero if no number |
|
$prefix = $a . "0"; |
|
} |
|
} |
|
|
|
# In very rare cases (right now I can only think of KH5K and KH7K and FRxG/T |
|
# etc), the prefix is wrong, for example KH5K/DJ1YFK would be KH5K0. In this |
|
# case, the superfluous part will be cropped. Since this, however, changes the |
|
# DXCC of the prefix, this will NOT happen when invoked from with an |
|
# extra parameter $_[1]; this will happen when invoking it from &dxcc. |
|
|
|
if (($prefix =~ /(\w+\d)[A-Z]+\d/) && (not defined $_[1])) { |
|
$prefix = $1; |
|
} |
|
|
|
return $prefix; |
|
} |
|
else { return undef; } # no proper callsign received. |
|
} # wpx ends here |
|
|
|
|
|
############################################################################## |
|
# |
|
# &dxcc determines the DXCC country of a given callsign using the cty.dat file |
|
# provided by K1EA at http://www.k1ea.com/cty/cty.dat . |
|
# An example entry of the file looks like this: |
|
# |
|
# Portugal: 14: 37: EU: 38.70: 9.20: 0.0: CT: |
|
# CQ,CR,CR5A,CR5EBD,CR6EDX,CR7A,CR8A,CR8BWW,CS,CS98,CT,CT98; |
|
# |
|
# The first line contains the name of the country, WAZ, ITU zones, continent, |
|
# latitude, longitude, UTC difference and main Prefix, the second line contains |
|
# possible Prefixes and/or whole callsigns that fit for the country, sometimes |
|
# followed by zones in brackets (WAZ in (), ITU in []). |
|
# |
|
# This sub checks the callsign against this list and the DXCC in which |
|
# the best match (most matching characters) appear. This is needed because for |
|
# example the CTY file specifies only "D" for Germany, "D4" for Cape Verde. |
|
# Also some "unusual" callsigns which appear to be in wrong DXCCs will be |
|
# assigned properly this way, for example Antarctic-Callsigns. |
|
# |
|
# Then the callsign (or what appears to be the part determining the DXCC if |
|
# there is a "/" in the callsign) will be checked against the list of prefixes |
|
# and the best matching one will be taken as DXCC. |
|
# |
|
# The return-value will be an array ("Country Name", "WAZ", "ITU", "Continent", |
|
# "latitude", "longitude", "UTC difference", "DXCC"). |
|
# |
|
############################################################################### |
|
|
|
sub dxcc { |
|
my $testcall = shift; |
|
my $matchchars=0; |
|
my $matchprefix=''; |
|
my $test; |
|
my $zones = ''; # annoying zone exceptions |
|
my $goodzone; |
|
my $letter=''; |
|
|
|
|
|
if ($testcall =~ /(^OH\/)|(\/OH[1-9]?$)/) { # non-Aland prefix! |
|
$testcall = "OH"; # make callsign OH = finland |
|
} |
|
elsif ($testcall =~ /(^3D2R)|(^3D2.+\/R)/) { # seems to be from Rotuma |
|
$testcall = "3D2RR"; # will match with Rotuma |
|
} |
|
elsif ($testcall =~ /^3D2C/) { # seems to be from Conway Reef |
|
$testcall = "3D2CR"; # will match with Conway |
|
} |
|
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 |
|
# intentionally be wrong, see &wpx! |
|
} |
|
|
|
$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; |
|
} |
|
} |
|
} |
|
|
|
my @mydxcc; # save typing work |
|
|
|
if (defined($dxcc{$matchprefix})) { |
|
@mydxcc = @{$dxcc{$matchprefix}}; |
|
} |
|
else { |
|
@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; |
|
} |
|
} |
|
|
|
# cty.dat has special entries for WAE countries which are not separate DXCC |
|
# countries. Those start with a "*", for example *TA1. Those have to be changed |
|
# 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 |
|
|
|
} |
|
|
|
# CTY.dat uses "/" in some DXCC names, but I prefer to remove them, for example |
|
# VP8/s ==> VP8s etc. |
|
|
|
$mydxcc[7] =~ s/\///g; |
|
|
|
return @mydxcc; |
|
|
|
} # dxcc ends here |
|
|
|
############################################################################### |
|
# &makewindow Creates and refreshes a window with given name and color |
|
# parameters. |
|
# Since a newly initialized window's background color is at the |
|
# default, not at the color specified with attron($win, COLOR_PAIR()) (or I am |
|
# just too stupid to find out how to do it properly), this sub fills the window |
|
# with whitespaces, so it will have the color which was specified with attron. |
|
# |
|
# usage: &makewindow($height, $width, $ypos, $xpos, $color pair); |
|
############################################################################### |
|
|
|
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 |
|
} |
|
|
|
########################################################################### |
|
# clearinputfields fills inputfields with spaces. |
|
# $_[0] -> window array |
|
# $_[1] -> when 1, clear windows 0..13, when 2 clear windows 0..25 |
|
# This is needed because in LOGGING mode only the first 14 windows are used |
|
########################################################################## |
|
|
|
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 |
|
} |
|
} |
|
|
|
|
|
########################################################################### |
|
# qsotofields puts the content of the qso array (referenced by $qso, $_[0]) |
|
# into the input windows $wi, referenced by $_[1] |
|
# When $_[2] is 1, it will update windows 0..13 for Logging mode |
|
# When $_[2] is 2, it will update windows 0..17 for Edit mode |
|
########################################################################## |
|
|
|
sub qsotofields { |
|
my @qso= @{$_[0]}; # reference to QSO |
|
my @wi = @{$_[1]}; # reference to input-windows |
|
my $num; # number of windows to paint |
|
|
|
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 |
|
} |
|
} |
|
|
|
############################################################################## |
|
# &saveqso Saves the passed array into the table log_$mycall, also adds |
|
# DXCC, Prefix, Continent and QSL-Info fields. |
|
# The QSL-Info is taken from the REMarks field, if it contains "via:<sth>". |
|
# the same applies for ITU, CQZ and IOTA, OPERATOR. Those can be entered in |
|
# the REMarks |
|
# field like OPERATOR:DL1LID ITU:34 CQZ:33 IOTA:EU-038 (with hyphen!). |
|
# These parts will be cut |
|
# out of the field if they represent a valid ITUZ, CQZ or IOTA nr. |
|
# The database is specified in the configfile and so are the server and the |
|
# port of the server. |
|
# If there is another parameter after the QSO-array, it is the number of the |
|
# QSO which is edited. This QSO has to be changed in the database then |
|
############################################################################## |
|
|
|
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 |
|
|
|
# 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 |
|
} |
|
|
|
# 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; |
|
} |
|
|
|
# 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]' |
|
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 |
|
# is allowed. added 0.2.1: new mode for [0-9.] added (for bands). |
|
# $_[2] contains the windownumber, $_[3] the reference to the |
|
# QSO-array and $_[0] the reference to the Input-window-Array. |
|
# |
|
# $_[4] is the reference to $wlog |
|
# |
|
# $_[5] either contains 0 (normal) or a QSO number. If it's a number, it means |
|
# that we are editing an existing QSO, meaning that we have to call &saveqso |
|
# with the number as additional argument, so it will not save it as a new QSO. |
|
# The variable will be called $editnr. |
|
# |
|
# $_[6] means overwrite mode if nonzero. |
|
# |
|
# $_[7] is the maximum length of the field. |
|
# |
|
# The things you enter via the keyboard will be checked and if they are |
|
# matching the criterias of $_[1], it will be printed into the window and saved |
|
# in @qso. Editing is possible with arrow keys, delete and backspace. |
|
# |
|
# If an F-Key is pressed, following things can happen: |
|
# 1. F2 --> Current QSO is saved into the database, |
|
# read last 16 QSOs from database, write them into $wlog. |
|
# delete @qso and the content of all inputfields. |
|
# return 4. When this is detected, the while-loop where the |
|
# inputs are taken (while ($aw == 1)) will be exited and then entered |
|
# again because $aw is still 1, but then it starts at the callsign |
|
# field again. |
|
# 2. F3 --> clears out the current QSO. |
|
# 3. F5 --> Reads frequency and mode from the rig |
|
# 3. F9 --> return 2 as next active window $aw. --> $wlog. |
|
# 4. F10 --> returns 3 as next active window --> $wqsos |
|
# |
|
# If a regular entry was made, the return value is 1, because we stay in active |
|
# window 1 |
|
############################################################################## |
|
|
|
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 string |
|
my $wlog = ${$_[4]}; # reference to log-windw |
|
my $editnr = ${$_[5]}; # reference to editnr |
|
|
|
my $debug=0; |
|
|
|
my $ovr = $_[6]; # overwrite |
|
my $maxlen = $_[7]; |
|
|
|
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 |
|
|
|
addstr($win,0,0, $input." "x80); # pass $input to window, |
|
# delete all after $input. |
|
$pos-- if ($pos == $maxlen); |
|
|
|
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) < $maxlen) || ($pos < $maxlen && $ovr)) |
|
) { |
|
|
|
unless ($_[1] == 3) { # Unless Name, QTH mode |
|
$ch =~ tr/[a-z]/[A-Z]/; # make letters uppercase |
|
} |
|
|
|
$pos++; |
|
|
|
if ($ovr) { |
|
$input = substr($input, 0, $pos-1).$ch.substr($input, $pos > |
|
length($input) ? $pos-1 : $pos, ); |
|
} |
|
else { |
|
$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) { |
|
if ($pos > 0) { $pos-- } |
|
} |
|
|
|
elsif ($ch eq KEY_RIGHT) { |
|
if ($pos < length($input)) { $pos++ } |
|
} |
|
|
|
elsif (($ch eq KEY_DC) && ($pos < length($input))) { # Delete key |
|
$input = substr($input, 0, $pos).substr($input, $pos+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)) |
|
&& ($pos > 0)) { |
|
$input = substr($input, 0, $pos-1).substr($input, $pos, ); |
|
$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]},$editnr)) { # save @QSO to DB |
|
&clearinputfields($_[0],1); # clear input fields 0..13 |
|
@{$_[3]} = ("","","","","","","","","","","","","",""); |
|
# 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 go 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]}[$_]); |
|
} |
|
foreach (@{$_[3]}) { # iterate through QSO-array |
|
$_=""; # clear content |
|
} |
|
${$_[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 |
|
} |
|
|
|
# F7 -> go to remote mode for fldigi |
|
elsif ($ch eq KEY_F(6)) { |
|
my $lookup = ${$_[3]}[0]; |
|
unless ($lookup) { $lookup = $input }; |
|
system("$browser http://www.qrz.com/$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 |
|
endwin; # Leave curses mode |
|
exit; |
|
} |
|
} |
|
} |
|
|
|
############################################################################## |
|
# &lastqsos Prints the last 16 QSOs into the $wlog window. depending on $_[1], |
|
# 16 or 8 QSOs are displayed, with different layout. |
|
############################################################################## |
|
|
|
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 = 8; |
|
$y=7; # 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); |
|
} |
|
|
|
|
|
############################################################################## |
|
# &callinfo When a new callsign is entered in the input form, this sub is |
|
# called and it prints |
|
# 1) The Name and QTH (from a separate database table), if available. |
|
# 2) The DXCC info, prefix, distance and beam heading. Info if new DXCC. |
|
# 3) The (max.) 16 last QSOs into the $wqsos-window. |
|
# 4) Club info (HSC, etc) |
|
# 5) IF $autoqueryrig = 1, get frequency / band from radio |
|
############################################################################## |
|
|
|
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 |
|
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, $prefix." " x (5-length($prefix))); |
|
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=8;} |
|
|
|
# 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]); |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
|
|
############################################################################## |
|
# &getdate; Uses gmtime() to get the current date in DDMMYYYY |
|
############################################################################## |
|
|
|
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; |
|
} |
|
|
|
############################################################################## |
|
# &gettime; Uses gmtime() to get the current UTC / GMT format HHMM |
|
############################################################################## |
|
|
|
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]; |
|
} |
|
|
|
############################################################################## |
|
# splashscreen returns the splash screen |
|
############################################################################## |
|
|
|
sub splashscreen { |
|
my $yfkver = $_[0]; |
|
return "YFKlog v$yfkver - a general purpose ham radio logbook |
|
|
|
Copyright (C) 2005-2008 Fabian Kurz, DJ1YFK |
|
|
|
This is free software, and you are welcome to redistribute it |
|
under certain conditions (see COPYING). |
|
|
|
YFKlog website: http://fkurz.net/ham/yfklog.html |
|
Your feedback is appreciated."; |
|
} |
|
return 1; |
|
|
|
############################################################################## |
|
# &choseqso This sub lets the OP chose a QSO from the logbook. It displays 16 |
|
# QSOs as usual in the $wlog window, the user can select a QSO with the cursor |
|
# keys. The list automatically scrolls up and down after the last or first QSO |
|
# in the window. PgUp and PgDwn jump a page up or down. |
|
# The return value is the NR of the selected QSO, as in the database column NR |
|
############################################################################## |
|
|
|
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) { |
|
$aline=7; |
|
$nbr = 8; |
|
} |
|
|
|
|
|
# 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 |
|
} |
|
|
|
elsif (($ch eq KEY_PPAGE) && $callsthispage>7) {# scroll up 16/8 QSOs |
|
$aline = ($nbr-1); # last line |
|
$offset += $nbr; # prev 8/16 QSOs |
|
} |
|
|
|
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]'"); |
|
$q->execute; |
|
@qso = $q->fetchrow_array; |
|
# proper format for the date (yyyy-mm-dd -> ddmmyyyy) |
|
$qso[1] = substr($qso[1],8,2).substr($qso[1],5,2).substr($qso[1],0,4); |
|
# proper format for the times. hh:mm:ss -> hhmm |
|
$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]); |
|
} |
|
|
|
return @qso; |
|
} |
|
|
|
############################################################################## |
|
# &chosepqso; Like &choseqso, but for the $wqsos window, where the Previous |
|
# QSOs are displayed. |
|
############################################################################## |
|
|
|
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 = 8; |
|
} |
|
|
|
# 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 |
|
|
|
} |
|
|
|
############################################################################## |
|
# entrymask - returns the strings to be printed into the input window $winput |
|
# just to make the main program more readable. Also used for the |
|
# EDIT and SEARCH fuction |
|
############################################################################## |
|
|
|
sub entrymask { |
|
if ($_[0] == 0) { |
|
return |
|
"Call: Date: T on: T off: Band: Mode: "; |
|
} |
|
elsif ($_[0] == 1) { |
|
return "QTH: Name: QSLs: QSLr: RSTs: RSTr: "; |
|
} |
|
elsif ($_[0] == 2) { |
|
return "Remarks: PWR: W "; |
|
} |
|
elsif ($_[0] == 3) { |
|
return "DXCC: PFX: CONT: ITUZ: CQ: QSLINFO:"; |
|
} |
|
else { |
|
return "IOTA: STATE: QSLrL: OP: GRID: QSO Nr: " |
|
} |
|
} |
|
|
|
############################################################################## |
|
# fkeyline - returns the line to be printed into the $whelp window. |
|
############################################################################## |
|
|
|
sub fkeyline { |
|
return "F2: Save Q F3: Clear Q F8: Input Window F9: Log window F10: Prev. QSO Window"; |
|
} |
|
|
|
############################################################################## |
|
# winfomask - returns the mask for the $winfo window.. |
|
############################################################################## |
|
|
|
sub winfomask { |
|
if ($_[0] == 0) { |
|
return "Country: DXCC: WPX: ITU: CQZ: "; |
|
} |
|
else { |
|
return "Lat: Long: Distance: Direction: "; |
|
} |
|
} |
|
|
|
############################################################################## |
|
# selectlist - Produces a (if needed scrollable) list of items to chose from. |
|
# $_[0] is the reference to the window where the list has to be displayed |
|
# $_[1] is the y position for the list to start (in curses tradition, y/x) |
|
# $_[2] is the x position for the list to start |
|
# $_[3] is the height of the list |
|
# $_[4] is the width of the list |
|
# $_[5] is a reference to an array of menu items |
|
# Pressing F1 returns "m" (used to go to the menu), F12 quits. |
|
############################################################################## |
|
|
|
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) |
|
|
|
# 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 |
|
} |
|
|
|
# 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 |
|
} |
|
} |
|
|
|
|
|
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 |
|
}# end of for(); |
|
|
|
refresh($win); |
|
|
|
$ch = getch(); |
|
|
|
if (($ch eq KEY_DOWN) && ($aline < $#items)) { # Arrow down was pressed |
|
# and 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 (($ch eq KEY_UP) && ($aline > 0)) { # arrow up, and 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 ($ch eq KEY_F(1)) { # F1 - Back to main menu |
|
return "m"; |
|
} |
|
elsif ($ch eq KEY_F(12)) { # F12 - QUIT YFKlog |
|
endwin(); |
|
exit; |
|
} |
|
elsif (ord($ch) eq '27') { |
|
$ch = getch(); |
|
if ($ch eq '1') { |
|
return "m"; |
|
} |
|
} |
|
|
|
} until ($ch =~ /\s/); |
|
|
|
return $aline; |
|
} # selectlist |
|
|
|
############################################################################## |
|
# &askbox Creates a window in which the user enters any value. |
|
############################################################################## |
|
|
|
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_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 |
|
} |
|
|
|
|
|
############################################################################## |
|
# toggleqsl - This sub gets window and either a callsign or the letter "W" as |
|
# parameters. |
|
# |
|
# If it receives a callsign, it queries the database for QSOs where the |
|
# callsign matches and displays them in a (if needed) scrollable list. |
|
# Within the list, the user can move up and down with arrow keys and |
|
# PG-up/down and toggle the QSL-R status of the selected QSO my pressing SPACE |
|
# bar and toggle QSL-S status (for people who 'reply' to incoming cards) |
|
# with S. |
|
# |
|
# If no callsign but a "W" is received, a list of all QSOs where the QSLS |
|
# ("QSL sent") status is "Q" (= Queued) is displayed. This mode is for manually |
|
# writing QSL cards. After a QSL was written, SPACEBAR toggles the status |
|
# to "Y" (Yes, QSL written) and back to "Q" if needed. |
|
############################################################################## |
|
|
|
|
|
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); |
|
|
|
|
|
# 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) = (22 - ($details * 5), 80); # x,y width of the window |
|
} |
|
else { # receive |
|
($yh, $xw) = (22, 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 |
|
|
|
$count = $c->fetchrow_array(); |
|
|
|
# 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 |
|
} |
|
} |
|
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("LOTW: %-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 |