From 846aa525969cab9b37936fb33b8705a68fd52886 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 20 May 2020 18:29:40 +0100 Subject: [PATCH] replace Storable->JSON in QSL.pm. Rename qsl.v1 -> dxsql.v2 and create_qsl.pl -> create_dxqsl.pl --- Changes | 1 + cmd/show/dxqsl.pl | 4 +- perl/QSL.pm | 50 ++++++++++++++++++++----- perl/Spot.pm | 2 +- perl/{create_qsl.pl => create_dxqsl.pl} | 24 +++++++++--- 5 files changed, 63 insertions(+), 18 deletions(-) rename perl/{create_qsl.pl => create_dxqsl.pl} (78%) diff --git a/Changes b/Changes index c2d4e117..18b220d3 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,7 @@ 1. Strip out conversion from users.v2 and v3 to new json format file into a new program called convert-users-v3-to-v4.pl. In theory, this program *could* be run at any time and is backported to mojo and master branches. +2. Replace Storable in dxqsl/QSL.pm and rename everything (except QSL.pm). 19May20======================================================================= 1. Convert all remaining commands and areas within the program that used the DB_File/Storable interface to DXUsers.pm to use the (hopefully) more stable diff --git a/cmd/show/dxqsl.pl b/cmd/show/dxqsl.pl index 2017a6ae..c17da1d2 100644 --- a/cmd/show/dxqsl.pl +++ b/cmd/show/dxqsl.pl @@ -14,17 +14,17 @@ my @out; return (1, $self->msg('db3', 'QSL')) unless $QSL::dbm; -push @out, $self->msg('qsl1'); foreach my $call (@call) { my $q = QSL::get($call); if ($q) { my $c = $call; + push @out, $self->msg('qsl1') unless @out; for (sort {$b->[2] <=> $a->[2]} @{$q->[1]}) { push @out, sprintf "%-14s %-10s %4d %s %s", $c, $_->[0], $_->[1], cldatetime($_->[2]), $_->[3]; $c = ""; } } else { - push @out, $self->msg('db2', $call, 'QSL'); + push @out, $self->msg('db2', $call, 'DxQSL DB'); } } diff --git a/perl/QSL.pm b/perl/QSL.pm index 67bffc32..5101f25f 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -2,7 +2,7 @@ # # Local 'autoqsl' module for DXSpider # -# Copyright (c) 2003 Dirk Koopman G1TLH +# Copyright (c) 2003-2020 Dirk Koopman G1TLH # package QSL; @@ -13,14 +13,17 @@ use DXUtil; use DB_File; use DXDebug; use Prefix; + use JSON; +use Data::Structure::Util qw(unbless); use vars qw($qslfn $dbm $maxentries); -$qslfn = 'qsl'; +$qslfn = 'dxqsl'; $dbm = undef; -$maxentries = 50; +$maxentries = 10; -localdata_mv("$qslfn.v2"); +my $json; +my %u; sub init { @@ -28,8 +31,9 @@ sub init my $ufn = localdata("$qslfn.v2"); Prefix::load() unless Prefix::loaded(); - - my %u; + $json = JSON->new->canonical(1); + + untie %u; undef $dbm; if ($mode) { $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)"; @@ -41,12 +45,14 @@ sub init sub finish { + untie %u; undef $dbm; } sub new { my ($pkg, $call) = @_; + return undef if $call =~ /INFO|QSL|VIA/; return bless [uc $call, []], $pkg; } @@ -62,7 +68,7 @@ sub update my $by = shift; my $changed; - return unless length $line && $line =~ /\b(?:QSL|VIA)\b/i; + return unless length $line && $line =~ /\b(?:QSL|VIA|BUR[OE]?A?U?|OQRS|LOTW)\b/i; foreach my $man (split /\b/, uc $line) { my $tok; @@ -73,6 +79,8 @@ sub update $tok = 'BUREAU'; } elsif ($man =~ /^LOTW/) { $tok = 'LOTW'; + } elsif ($man =~ /^OQRS/) { + $tok = 'OQRS'; } elsif ($man eq 'HC' || $man =~ /^HOM/ || $man =~ /^DIR/) { $tok = 'HOME CALL'; } elsif ($man =~ /^QRZ/) { @@ -105,11 +113,11 @@ sub get { return undef unless $dbm; my $key = uc shift; + my $value; - my $r = $dbm->get($key, $value); return undef if $r; - return thaw($value); + return json_decode($value); } sub put @@ -117,8 +125,30 @@ sub put return unless $dbm; my $self = shift; my $key = $self->[0]; - my $value = nfreeze($self); + my $value = json_encode($self); $dbm->put($key, $value); } +sub json_decode +{ + my $s = shift; + my $ref; + eval { $ref = $json->decode($s) }; + if ($ref && !$@) { + return bless $ref, __PACKAGE__; + } else { + LogDbg('DXUser', "__PACKAGE_::json_decode: on '$s' $@"); + } + return undef; +} + +sub json_encode +{ + my $ref = shift; + unbless($ref); + my $s = $json->encode($ref); + bless $ref, __PACKAGE__; + return $s; +} + 1; diff --git a/perl/Spot.pm b/perl/Spot.pm index 74b3f773..2d04f411 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -222,7 +222,7 @@ sub add } if ($_[3] =~ /(?:QSL|VIA)/i) { my $q = QSL::get($_[1]) || new QSL $_[1]; - $q->update($_[3], $_[2], $_[4]); + $q->update($_[3], $_[2], $_[4]) if $q; } } diff --git a/perl/create_qsl.pl b/perl/create_dxqsl.pl similarity index 78% rename from perl/create_qsl.pl rename to perl/create_dxqsl.pl index f4083f55..0a98649e 100755 --- a/perl/create_qsl.pl +++ b/perl/create_dxqsl.pl @@ -36,13 +36,16 @@ my $qslfn = "qsl"; $main::systime = time; -unlink "$data/qsl.v1"; -unlink "$local_data/qsl.v1"; +unlink "$data/qsl.v2"; +unlink "$local_data/qsl.v2"; QSL::init(1) or die "cannot open QSL file"; my $base = localdata("spots"); +my $tu = 0; +my $tr = 0; + opendir YEAR, $base or die "$base $!"; foreach my $year (sort readdir YEAR) { next if $year =~ /^\./; @@ -55,22 +58,33 @@ foreach my $year (sort readdir YEAR) { my $fn = "$baseyear/$day"; my $f = new IO::File $fn or die "$fn ($!)"; - print "doing: $fn\n"; + print "doing: $fn"; + my $u = 0; + my $r = 0; while (<$f>) { last if $end; if (/(QSL|VIA)/i) { my ($freq, $call, $t, $comment, $by, @rest) = split /\^/; my $q = QSL::get($call) || new QSL $call; - $q->update($comment, $t, $by); - $lasttime = $t; + if ($q) { + $q->update($comment, $t, $by); + $lasttime = $t; + ++$u; + ++$tu; + } } + ++$r; + ++$tr; } + printf " - Spots read %8d QSLs %6d\n", $r, $u; $f->close; last if $end; } last if $end; } +print "Total Spots read: $tr - QSLs found: $tu\n"; + QSL::finish(); exit(0); -- 2.43.0