+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
'^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',
$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);
use strict;
+use DXVars;
use DXUtil;
use DXDebug;
use DXDupe;
-use DXVars;
+use DXLog;
+use DXLogPrint;
use vars qw(%dup $duplth $dupage $filterdef);
['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
#
# 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;
$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)\^}};
}
$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>) {
}
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;
}
}
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
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);
$dirprefix = "$main::local_data/wwv";
$param = "$dirprefix/param";
+our $maxcache = 10;
+our @cache;
+
+
$filterdef = bless ([
# tag, sort, field, priv, special parser
['by', 'c', 0],
{
$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 $@;
}
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)
{
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--) {
}
);
- $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;
use Route;
use Route::User;
use DXUtil;
+use DXJSON;
+use Time::HiRes qw(gettimeofday);
use strict;
%list = ();
$max = 0;
$obscount = 3;
+our $cachefn = localdata('route_node_cache');
sub count
{
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;
use DXDebug;
use Route;
use DXUtil;
+use DXJSON;
+use Time::HiRes qw(gettimeofday);
use strict;
%list = ();
$max = 0;
+our $cachefn = localdata('route_user_cache');
+
sub count
{
my $n = scalar(keys %list);
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
#
$dirprefix = "$main::local_data/wcy";
$param = "$dirprefix/param";
+our $maxcache = 20;
+our @cache;
+
+
$filterdef = bless ([
# tag, sort, field, priv, special parser
['by', 'c', 11],
{
$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 $@;
}
$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) = @_;
{
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--) {
}
}
);
-
- $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;
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
projects / spider.git / commitdiff