From: Dirk Koopman Date: Wed, 20 May 2020 17:29:40 +0000 (+0100) Subject: replace Storable->JSON in QSL.pm. X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=846aa525969cab9b37936fb33b8705a68fd52886 replace Storable->JSON in QSL.pm. Rename qsl.v1 -> dxsql.v2 and create_qsl.pl -> create_dxqsl.pl --- 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_dxqsl.pl b/perl/create_dxqsl.pl new file mode 100755 index 00000000..0a98649e --- /dev/null +++ b/perl/create_dxqsl.pl @@ -0,0 +1,92 @@ +#!/usr/bin/env perl +# +# Implement a 'GO' database list +# +# Copyright (c) 2003 Dirk Koopman G1TLH +# +# +# + +# search local then perl directories +BEGIN { + use vars qw($root); + + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +use strict; + +use IO::File; +use SysVar; +use DXUtil; +use Spot; +use QSL; + +use vars qw($end $lastyear $lastday $lasttime); + +$end = 0; +$SIG{TERM} = $SIG{INT} = sub { $end++ }; + +my $qslfn = "qsl"; + +$main::systime = time; + +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 =~ /^\./; + + my $baseyear = "$base/$year"; + opendir DAY, $baseyear or die "$baseyear $!"; + foreach my $day (sort readdir DAY) { + next unless $day =~ /(\d+)\.dat$/; + my $dayno = $1 + 0; + + my $fn = "$baseyear/$day"; + my $f = new IO::File $fn or die "$fn ($!)"; + 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; + 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); + + diff --git a/perl/create_qsl.pl b/perl/create_qsl.pl deleted file mode 100755 index f4083f55..00000000 --- a/perl/create_qsl.pl +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/env perl -# -# Implement a 'GO' database list -# -# Copyright (c) 2003 Dirk Koopman G1TLH -# -# -# - -# search local then perl directories -BEGIN { - use vars qw($root); - - # root of directory tree for this system - $root = "/spider"; - $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; - - unshift @INC, "$root/perl"; # this IS the right way round! - unshift @INC, "$root/local"; -} - -use strict; - -use IO::File; -use SysVar; -use DXUtil; -use Spot; -use QSL; - -use vars qw($end $lastyear $lastday $lasttime); - -$end = 0; -$SIG{TERM} = $SIG{INT} = sub { $end++ }; - -my $qslfn = "qsl"; - -$main::systime = time; - -unlink "$data/qsl.v1"; -unlink "$local_data/qsl.v1"; - -QSL::init(1) or die "cannot open QSL file"; - -my $base = localdata("spots"); - -opendir YEAR, $base or die "$base $!"; -foreach my $year (sort readdir YEAR) { - next if $year =~ /^\./; - - my $baseyear = "$base/$year"; - opendir DAY, $baseyear or die "$baseyear $!"; - foreach my $day (sort readdir DAY) { - next unless $day =~ /(\d+)\.dat$/; - my $dayno = $1 + 0; - - my $fn = "$baseyear/$day"; - my $f = new IO::File $fn or die "$fn ($!)"; - print "doing: $fn\n"; - 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; - } - } - $f->close; - last if $end; - } - last if $end; -} - -QSL::finish(); - -exit(0); - -