From 5835ca385fb719194163512276666aaf75e82484 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 29 Dec 2021 01:08:55 +0000 Subject: [PATCH] route cache, wcy, wwv. ann caching --- Changes | 6 +++++ cmd/Aliases | 22 ++++++++--------- cmd/show/announce.pl | 11 ++++++++- perl/AnnTalk.pm | 23 +++++++++++++++-- perl/DXLogPrint.pm | 28 +++++++++++++++------ perl/DXProt.pm | 3 +++ perl/Geomag.pm | 57 ++++++++++++++++++++++++++++-------------- perl/Route/Node.pm | 28 +++++++++++++++++++++ perl/Route/User.pm | 28 +++++++++++++++++++++ perl/WCY.pm | 59 +++++++++++++++++++++++++++++--------------- perl/cluster.pl | 3 +++ 11 files changed, 207 insertions(+), 61 deletions(-) diff --git a/Changes b/Changes index 6b338945..3c520959 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,11 @@ +28Dec21======================================================================= +1. Fix issues with wwv & wcy updates into the cache. +2. Add a simple sh/announce cache to stop spawning when used (especially) in + a script. 27Dec21======================================================================= 1. Fix "kwalitee control" issue in /spider/cmd/dx.pl. +2. Make sh/wcy and sh/wwv cacheble for simple queries. +3. Fix set/nodxxxxxx etc. 22Dec21======================================================================= 1. Add the possibility to do "sender verify" that spots (and later on, other things like announce etc) are coming from spotters that exist on the node diff --git a/cmd/Aliases b/cmd/Aliases index f2b9b6ac..246e8ab7 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -103,17 +103,17 @@ package CmdAlias; '^sb$', 'send noprivate', 'send', '^set/dbg$', 'set/debug', 'set/debug', '^set/home$', 'set/homenode', 'set/homenode', - '^set/nobe', 'unset/beep', 'unset/beep', - '^set/nohe', 'unset/here', 'unset/here', - '^set/noan', 'unset/announce', 'unset/announce', - '^set/nodxg', 'unset/dxgrid', 'unset/dxgrid', - '^set/nodx', 'unset/dx', 'unset/dx', - '^set/noe', 'unset/echo', 'unset/echo', - '^set/nota', 'unset/talk', 'unset/talk', - '^set/noww', 'unset/wwv', 'unset/wwv', - '^set/nowx', 'unset/wx', 'unset/wx', - '^set/nosk', 'set/wantrbn none', 'set/wantrbn', - '^set/sk', 'set/wantrbn', 'set/wantrbn', + '^set/nobee?p?$', 'unset/beep', 'unset/beep', + '^set/noher?e?$', 'unset/here', 'unset/here', + '^set/noann?o?u?', 'unset/announce', 'unset/announce', + '^set/nodxgr?i?d?$', 'unset/dxgrid', 'unset/dxgrid', + '^set/nodx$', 'unset/dx', 'unset/dx', + '^set/noec?h?o?$', 'unset/echo', 'unset/echo', + '^set/notal?k?$', 'unset/talk', 'unset/talk', + '^set/nowwv?$', 'unset/wwv', 'unset/wwv', + '^set/nowx$', 'unset/wx', 'unset/wx', + '^set/noski?m?m?e?r?$', 'set/wantrbn none', 'set/wantrbn', + '^set/ski?m?m?e?r?$', 'set/wantrbn', 'set/wantrbn', '^set$', 'apropos set', 'apropos', '^sho?w?/u$', 'show/user', 'show/user', '^sho?w?/bul', 'show/files bulletins', 'show/files', diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl index 267d27c3..d069f976 100644 --- a/cmd/show/announce.pl +++ b/cmd/show/announce.pl @@ -40,7 +40,16 @@ while ($f = shift @f) { # next field $to = 20 unless $to; $from = 0 unless $from; -return (1, DXLog::print($from, $to, $main::systime, 'ann', $who)) if $self->{_nospawn};; +# if we can get it out of the cache than do it +if (!$who && !$from && $to < @AnnTalk::anncache) { + my @in = @AnnTalk::anncache[-$to .. -1]; + for (@in) { + push @out, DXLog::print_item($_); + } + return (1, @out); +} + +return (1, DXLog::print($from, $to, $main::systime, 'ann', $who)) if $self->{_nospawn} || $DB::VERSION; return (1, $self->spawn_cmd("show/announce $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'ann', $who])); return (1, @out); diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index ee7ea515..ae3337f7 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -10,10 +10,12 @@ package AnnTalk; use strict; +use DXVars; use DXUtil; use DXDebug; use DXDupe; -use DXVars; +use DXLog; +use DXLogPrint; use vars qw(%dup $duplth $dupage $filterdef); @@ -36,7 +38,24 @@ $filterdef = bless ([ ['origin_zone', 'nz', 12], ['by_state', 'nz', 13], ['origin_state', 'nz', 14], - ], 'Filter::Cmd'); + ], 'Filter::Cmd'); + +our $maxcache = 30; +our @anncache; + +sub init +{ + @anncache = DXLog::search(0, $maxcache, $main::systime, 'ann'); + shift @anncache while @anncache > $maxcache; + my $l = @anncache; + dbg("AnnTalk: loaded last $l announcements into cache"); +} + +sub add_anncache +{ + push @anncache, [ $main::systime, @_ ]; + shift @anncache while @anncache > $maxcache; +} # enter the spot for dup checking and return true if it is already a dup sub dup diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 244402d6..32f39c26 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -36,11 +36,11 @@ $maxmonths = 36; # # This command outputs a list of n lines starting from time t with $pattern tags # -sub print +sub search { my $fcb = $DXLog::log; - my $from = shift || 0; - my $to = shift || 10; + my $from = shift // 0; + my $to = shift // 10; my $jdate = $fcb->unixtoj(shift); my $pattern = shift; my $who = shift; @@ -53,8 +53,10 @@ sub print $who = uc $who if defined $who; + dbg("from: $from to: $to pattern: $pattern hint: $hint") if isdbg('search'); + if ($pattern) { - $hint = q{m{\Q$pattern\E}i}; + $hint = qq{m{\Q$pattern\E}i}; } else { $hint = q{!m{\^(?:ann|rcmd|talk|chat)\^}}; } @@ -63,7 +65,7 @@ sub print $hint .= q{m{\Q$who\E}i}; } $hint = "next unless $hint" if $hint; - $hint .= "; next unless m{^\\d+\\^$pattern\\^}" if $pattern; + $hint .= "; next unless m{^\\d+\\^$pattern\\^}i" if $pattern; $hint ||= ""; $eval = qq(while (<\$fh>) { @@ -113,9 +115,19 @@ sub print } for (sort {$a <=> $b } @in) { - my @line = split /\^/ ; - push @out, print_item(\@line); - + push @out, [ split /\^/ ] + } + + return @out; +} + +sub print +{ + my @out; + + my @in = search(@_); + for (@in) { + push @out, print_item($_); } return @out; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index fe7af2dd..4886a7ff 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -738,6 +738,7 @@ sub send_announce } Log('ann', $target, $from, $text); + AnnTalk::add_anncache('ann', $target, $from, $text); # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on @@ -1777,6 +1778,8 @@ sub import_chat my $via = $target; $via = '*' if $target eq 'ALL' || $target eq 'SYSOP'; Log('ann', $target, $main::mycall, $text); + AnnTalk::add_anncache('ann', $target, $main::mycall, $text); + $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text)); } else { DXCommandmode::send_chats($main::me, $target, $text); diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 3447743f..9b4421d8 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -41,6 +41,10 @@ $dupage = 12*3600; # the length of time to hold spot dups $dirprefix = "$main::local_data/wwv"; $param = "$dirprefix/param"; +our $maxcache = 10; +our @cache; + + $filterdef = bless ([ # tag, sort, field, priv, special parser ['by', 'c', 0], @@ -58,6 +62,10 @@ sub init { $fp = DXLog::new('wwv', 'dat', 'm'); do "$param" if -e "$param"; + # read in existing data + @cache = readfile($main::systime); + shift @cache while @cache > $maxcache; + dbg(sprintf "WWV read in last %d records into cache", scalar @cache); confess $@ if $@; } @@ -79,7 +87,10 @@ sub store close $fh; # log it - $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node^$r"); + my $s ="$from^$date^$sfi^$a^$k^$forecast^$node^$r"; + $fp->writeunix($date, $s); + push @cache, [ split /\^/, $s ]; + shift @cache while @cache > $maxcache; } # update WWV info in one go (usually from a PC23) @@ -177,15 +188,22 @@ sub search { my $from = shift; my $to = shift; - my $date = $fp->unixtoj(shift); + my $t = shift; + my $date = $fp->unixtoj($t); my $pattern = shift; my $search; my @out; my $eval; my $count; - - $search = 1; - $eval = qq( + + if ($t == $main::systime && ($to <= $maxcache)) { + dbg("using wwv cache") if isdbg('wwv'); + @out = reverse @cache; + pop @out while @out > $to; + } else { + dbg("using wwv file(s))") if isdbg('wwv'); + $search = 1; + $eval = qq( my \$c; my \$ref; for (\$c = \$#in; \$c >= 0; \$c--) { @@ -199,22 +217,23 @@ sub search } ); - $fp->close; # close any open files - - my $fh = $fp->open($date); - for ($count = 0; $count < $to; ) { - my @in = (); - if ($fh) { - while (<$fh>) { - chomp; - push @in, [ split '\^' ] if length > 2; + $fp->close; # close any open files + + my $fh = $fp->open($date); + for ($count = 0; $count < $to; ) { + my @in = (); + if ($fh) { + while (<$fh>) { + chomp; + push @in, [ split '\^' ] if length > 2; + } + eval $eval; # do the search on this file + return ("Geomag search error", $@) if $@; + last if $count >= $to; # stop after n } - eval $eval; # do the search on this file - return ("Geomag search error", $@) if $@; - last if $count >= $to; # stop after n + $fh = $fp->openprev(); # get the next file + last if !$fh; } - $fh = $fp->openprev(); # get the next file - last if !$fh; } return @out; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 76d98757..90f691e4 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -12,6 +12,8 @@ use DXDebug; use Route; use Route::User; use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); use strict; @@ -38,6 +40,7 @@ $filterdef = $Route::filterdef; %list = (); $max = 0; $obscount = 3; +our $cachefn = localdata('route_node_cache'); sub count { @@ -392,6 +395,31 @@ sub PC92C_dxchan return (%{$parent->{PC92C_dxchan}}); } +sub TO_JSON { return { %{ shift() } }; } + +sub write_cache +{ + my $json = DXJSON->new; + $json->canonical(0)->allow_blessed(1)->convert_blessed(1); + + my $ta = [ gettimeofday ]; + $json->indent(1)->canonical(1) if isdbg('routecache'); + my $s = eval {$json->encode(\%list)}; + if ($s) { + my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); + $fh->print($s); + $fh->close; + } else { + dbg("Route::User:Write_cache error '$@'"); + return; + } + $json->indent(0)->canonical(0); + my $diff = _diffms($ta); + my $size = sprintf('%.3fKB', (length($s) / 1000)); + dbg("Route::User:WRITE_CACHE size: $size time to write: $diff mS"); +} + + sub DESTROY { my $self = shift; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 8c1c824d..51d14f21 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -11,6 +11,8 @@ package Route::User; use DXDebug; use Route; use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); use strict; @@ -21,6 +23,8 @@ $filterdef = $Route::filterdef; %list = (); $max = 0; +our $cachefn = localdata('route_user_cache'); + sub count { my $n = scalar(keys %list); @@ -94,6 +98,30 @@ sub delparent return $self->_dellist('parent', @_); } +sub TO_JSON { return { %{ shift() } }; } + +sub write_cache +{ + my $json = DXJSON->new; + $json->canonical(0)->allow_blessed(1)->convert_blessed(1); + + my $ta = [ gettimeofday ]; + $json->indent(1)->canonical(1) if isdbg('routecache'); + my $s = eval {$json->encode(\%list)}; + if ($s) { + my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); + $fh->print($s); + $fh->close; + } else { + dbg("Route::User:Write_cache error '$@'"); + return; + } + $json->indent(0)->canonical(0); + my $diff = _diffms($ta); + my $size = sprintf('%.3fKB', (length($s) / 1000)); + dbg("Route::User:WRITE_CACHE size: $size time to write: $diff mS"); +} + # # generic AUTOLOAD for accessors # diff --git a/perl/WCY.pm b/perl/WCY.pm index 826208e5..50476886 100644 --- a/perl/WCY.pm +++ b/perl/WCY.pm @@ -42,6 +42,10 @@ $dupage = 12*3600; # the length of time to hold spot dups $dirprefix = "$main::local_data/wcy"; $param = "$dirprefix/param"; +our $maxcache = 20; +our @cache; + + $filterdef = bless ([ # tag, sort, field, priv, special parser ['by', 'c', 11], @@ -59,6 +63,10 @@ sub init { $fp = DXLog::new('wcy', 'dat', 'm'); do "$param" if -e "$param"; + # read in existing data + @cache = readfile($main::systime); + shift @cache while @cache > $maxcache; + dbg(sprintf "WCY read in last %d records into cache", scalar @cache); confess $@ if $@; } @@ -76,10 +84,13 @@ sub store $fh->close; # log it - $fp->writeunix($date, "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node"); + my $s = "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node"; + $fp->writeunix($date, $s); + push @cache, [ split /\^/, $s ]; + shift @cache while @cache > $maxcache; } -# update WWV info in one go (usually from a PC23) +# update WCY info in one go (usually from a PC23) sub update { my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_; @@ -151,16 +162,23 @@ sub search { my $from = shift; my $to = shift; - my $date = $fp->unixtoj(shift); + my $t = shift; + my $date = $fp->unixtoj($t); my $pattern = shift; my $search; my @out; my $eval; my $count; my $i; - - $search = 1; - $eval = qq( + + if ($t == $main::systime && ($to <= $maxcache)) { + dbg("using wcy cache") if isdbg('wcy'); + @out = reverse @cache; + pop @out while @out > $to; + } else { + dbg("using wwv file(s))") if isdbg('wwv'); + $search = 1; + $eval = qq( my \$c; my \$ref; for (\$c = \$#in; \$c >= 0; \$c--) { @@ -173,22 +191,23 @@ sub search } } ); - - $fp->close; # close any open files - my $fh = $fp->open($date); - for ($i = $count = 0; $count < $to; $i++ ) { - my @in = (); - if ($fh) { - while (<$fh>) { - chomp; - push @in, [ split '\^' ] if length > 2; + + $fp->close; # close any open files + my $fh = $fp->open($date); + for ($i = $count = 0; $count < $to; $i++ ) { + my @in = (); + if ($fh) { + while (<$fh>) { + chomp; + push @in, [ split '\^' ] if length > 2; + } + eval $eval; # do the search on this file + return ("Geomag search error", $@) if $@; + last if $count >= $to; # stop after n } - eval $eval; # do the search on this file - return ("Geomag search error", $@) if $@; - last if $count >= $to; # stop after n + $fh = $fp->openprev(); # get the next file + last if !$fh; } - $fh = $fp->openprev(); # get the next file - last if !$fh; } return @out; diff --git a/perl/cluster.pl b/perl/cluster.pl index 818718f8..ffdfa42d 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -578,6 +578,9 @@ sub setup_start DXUser::init(4); # version 4 == json format Filter::init(); # doesn't do much, but has to be done + + AnnTalk::init(); # initialise announce cache + # look for the sysop and the alias user and complain if they aren't there -- 2.43.0