]> dxcluster.org Git - spider.git/commitdiff
route cache, wcy, wwv. ann caching
authorDirk Koopman <djk@tobit.co.uk>
Wed, 29 Dec 2021 01:08:55 +0000 (01:08 +0000)
committerDirk Koopman <djk@tobit.co.uk>
Wed, 29 Dec 2021 01:08:55 +0000 (01:08 +0000)
Changes
cmd/Aliases
cmd/show/announce.pl
perl/AnnTalk.pm
perl/DXLogPrint.pm
perl/DXProt.pm
perl/Geomag.pm
perl/Route/Node.pm
perl/Route/User.pm
perl/WCY.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index 6b33894557e4a75c61b09392318c37278911e9e3..3c5209599e00804e369c12503192809a7be95345 100644 (file)
--- 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
index f2b9b6acd87b8ffec7cf54c92a237199a43b3d12..246e8ab74e553d036c72157587c149b9d03456d6 100644 (file)
@@ -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',
index 267d27c330a4fe47181a8a8086c8a172dee4e5b2..d069f9768ad498b5ced24aeecb1e865d3839384e 100644 (file)
@@ -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);
index ee7ea51570164916e925f08f34eb24c79dae46ee..ae3337f764e6b44d5aa5a2c54eeeaa33ce24e60f 100644 (file)
@@ -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
index 244402d6962493e685edb147cd734e83427284f3..32f39c26904d2560652ed1870651688834f3a55c 100644 (file)
@@ -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;
 }
index fe7af2dd7b24d7e8ddc20fbdf02f4e4ee01c1886..4886a7ff3ce736ef8876b887c9526fc7be462d6b 100644 (file)
@@ -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);
index 3447743ffafc76a47b14e60481630006db1efddc..9b4421d821cb10c4b2db24277536d28eba6ec1db 100644 (file)
@@ -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;
index 76d987572e3e789f6beee90ba9a0ed0bfcddbcf3..90f691e44e343e47c27de6d3868649d9d3f8f683 100644 (file)
@@ -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;
index 8c1c824de5f58d4bf5e389aee4b40d675f259c65..51d14f21382951ed14b422dc43c2521678f6f16c 100644 (file)
@@ -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
 #
index 826208e5332edf7604335ece130726410307bf5d..504768860717204fc0f70814b6f1ca7e55c6ab8b 100644 (file)
@@ -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;
index 818718f870d3459a7aa648a342c2c10f2a136fa0..ffdfa42df1fd691acca53f4ed674a8c48cc8032c 100755 (executable)
@@ -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