From 963a74a359bda8ac6c348977f70d85e8e879697a Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 8 Jun 2020 14:49:27 +0100 Subject: [PATCH] fix sh/mydx, add back qra sq for sh/dxgrid --- Changes | 4 ++++ cmd/links.pl | 4 ++-- cmd/show/dx.pl | 1 + perl/DXCommandmode.pm | 17 +++++++++++++---- perl/DXUser.pm | 13 ++++++++++--- perl/LRU.pm | 38 +++++++++++++++++++++++--------------- perl/Prefix.pm | 2 +- perl/RBN.pm | 2 +- perl/Spot.pm | 31 +++++++++++-------------------- 9 files changed, 66 insertions(+), 46 deletions(-) diff --git a/Changes b/Changes index fd5711ae..6cdc906a 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ +08Jun20======================================================================= +1. Fix show/mydx (lack of) filtering bug. +2. Add qra locator to prefix_data.pl +3. Add 4 digit qra square for spotted callsign if show/dxgrid is enabled 03Jun20======================================================================= 1. Make sure that all possible regexes get passed across to the search engine. 2. Fix out of order logging on sh/log queries spanning more than one month. diff --git a/cmd/links.pl b/cmd/links.pl index 641f977b..ab3f27a2 100644 --- a/cmd/links.pl +++ b/cmd/links.pl @@ -29,7 +29,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) { my $pingint = $dxchan->pingint; my $lastt = $dxchan->lastping ? ($dxchan->pingint - ($nowt - $dxchan->lastping)) : $pingint; my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%7.2f",$dxchan->pingave) : ""; - my $iso = $dxchan->isolate ? 'Y' :' '; + my $iso = $dxchan->isolate ? 'Y' : ' '; my $uptime = difft($dxchan->startt, 1); my ($fin, $fout, $pc92) = (' ', ' ', ' '); if ($dxchan->do_pc9x) { @@ -45,7 +45,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) { } unless ($pingint) { $lastt = 0; - $ping = " "; + $ping = " "; } $sort = "DXSP" if $dxchan->is_spider; diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index 94fbb7d8..baca1f68 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -159,6 +159,7 @@ sub handle return (0, "sh/dx parse error '$r' " . $filter) if $r; $user ||= ''; + $expr ||= ''; dbg "sh/dx user: $user expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('sh/dx'); # now do the search diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 8bb6659e..900460ae 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -994,12 +994,21 @@ sub format_dx_spot my $loc = ''; my $clth = $self->{consort} eq 'local' ? 29 : 30; my $comment = substr (($_[3] || ''), 0, $clth); - $comment .= ' ' x ($clth - length($comment)); + $comment .= ' ' x ($clth - (length($comment))); + if ($self->{user}->wantgrid) { + my $ref = DXUser::get_current($_[1]); + if ($ref && $ref->qra) { + $loc = ' ' . substr($ref->qra, 0, 4); + $comment = substr $comment, 0, ($clth - (length($comment)+length($loc))); + $comment .= $loc; + $loc = ''; + } + } + if ($self->{user}->wantgrid) { my $ref = DXUser::get_current($_[4]); - if ($ref) { - $loc = $ref->qra || ''; - $loc = ' ' . substr($loc, 0, 4) if $loc; + if ($ref && $ref->qra) { + $loc = ' ' . substr($ref->qra, 0, 4); } } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index b33f8823..5d212b07 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -27,7 +27,7 @@ $dbm = undef; $filename = undef; $lastoperinterval = 60*24*60*60; $lasttime = 0; -$lrusize = 2000; +$lrusize = 10000; $tooold = 86400 * 365; # this marks an old user who hasn't given enough info to be useful $v3 = 0; our $maxconnlist = 3; # remember this many connection time (duration) [start, end] pairs @@ -44,6 +44,7 @@ our $maxconnlist = 3; # remember this many connection time (duration) [start, email => '0,E-mail Address,parray', priv => '9,Privilege Level', lastin => '0,Last Time in,cldatetime', + lastseen => '0,Last Seen,cldatetime', passwd => '9,Password,yesno', passphrase => '9,Pass Phrase,yesno', addr => '0,Full Address', @@ -213,6 +214,7 @@ sub process sub finish { + $dbm->sync; undef $dbm; untie %u; } @@ -238,6 +240,7 @@ sub new # confess "can't create existing call $call in User\n!" if $u{$call}; my $self = $pkg->alloc($call); + $self->{lastseen} = $main::systime; $self->put; return $self; } @@ -254,7 +257,10 @@ sub get # is it in the LRU cache? my $ref = $lru->get($call); - return $ref if $ref && ref $ref eq 'DXUser'; + if ($ref && ref $ref eq 'DXUser') { + $ref->{lastseen} = $main::systime; + return $ref; + } # search for it unless ($dbm->get($call, $data)) { @@ -274,6 +280,7 @@ sub get } return undef; } + $ref->{lastseen} = $main::systime; $lru->put($call, $ref); return $ref; } @@ -406,7 +413,7 @@ sub close my $self = shift; my $startt = shift; my $ip = shift; - $self->{lastin} = $main::systime; + $self->{lastseen} = $self->{lastin} = $main::systime; # add a record to the connect list my $ref = [$startt || $self->{startt}, $main::systime]; push @$ref, $ip if $ip; diff --git a/perl/LRU.pm b/perl/LRU.pm index d86c36d5..5084a695 100644 --- a/perl/LRU.pm +++ b/perl/LRU.pm @@ -26,20 +26,27 @@ use DXDebug; use vars qw(@ISA); @ISA = qw(Chain); +use constant OBJ => 2; +use constant MAX => 3; +use constant INUSE => 4; +use constant NAME => 5; +use constant CALLBACK => 6; + sub newbase { my $pkg = shift; my $name = shift; my $max = shift; + my $callback = shift; confess "LRU->newbase requires a name and maximal count" unless $name && $max; - return $pkg->SUPER::new({ }, $max, 0, $name); + return $pkg->SUPER::new({ }, $max, 0, $name, $callback); } sub get { my ($self, $call) = @_; if (my $p = $self->obj->{$call}) { - dbg("LRU $self->[5] cache hit $call") if isdbg('lru'); + dbg("LRU $self->[NAME] cache hit $call") if isdbg('lru'); $self->rechain($p); return $p->obj; } @@ -53,42 +60,43 @@ sub put my $p = $self->obj->{$call}; if ($p) { # update the reference and rechain it - dbg("LRU $self->[5] cache update $call") if isdbg('lru'); + dbg("LRU $self->[NAME] cache update $call") if isdbg('lru'); $p->obj($ref); $self->rechain($p); } else { # delete one of the end of the chain if required - while ($self->[4] >= $self->[3] ) { + while ($self->[INUSE] >= $self->[MAX] ) { $p = $self->prev; - my $call = $p->[3]; - dbg("LRU $self->[5] cache LRUed out $call now $self->[4]/$self->[3]") if isdbg('lru'); + my $call = $p->[MAX]; + dbg("LRU $self->[NAME] cache LRUed out $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); $self->remove($call); } # add a new one - dbg("LRU $self->[5] cache add $call now $self->[4]/$self->[3]") if isdbg('lru'); + dbg("LRU $self->[NAME] cache add $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); $p = $self->new($ref, $call); $self->add($p); $self->obj->{$call} = $p; - $self->[4]++; + $self->[INUSE]++; } } sub remove { my ($self, $call) = @_; - my $q = $self->obj->{$call}; - confess("$call is already removed") unless $q; - dbg("LRU $self->[5] cache remove $call now $self->[4]/$self->[3]") if isdbg('lru'); - $q->obj(1); - $q->SUPER::del; + my $p = $self->obj->{$call}; + confess("$call is already removed") unless $p; + dbg("LRU $self->[NAME] cache remove $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); + &{$self->[CALLBACK]}($p->obj) if $self->[CALLBACK]; # call back if required + $p->obj(1); + $p->SUPER::del; delete $self->obj->{$call}; - $self->[4]--; + $self->[INUSE]--; } sub count { - return $_[0]->[4]; + return $_[0]->[INUSE]; } 1; diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 37afddf7..659178fb 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -26,7 +26,7 @@ $db = undef; # the DB_File handle %prefix_loc = (); # the meat of the info %pre = (); # the prefix list $hits = $misses = $matchtotal = 1; # cache stats -$lrusize = 1000; # size of prefix LRU cache +$lrusize = 10000; # size of prefix LRU cache sub init { diff --git a/perl/RBN.pm b/perl/RBN.pm index 30667d61..ba81f735 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -21,7 +21,7 @@ use Date::Parse; our @ISA = qw(DXChannel); -our $startup_delay =5*60; # don't send anything out until this timer has expired +our $startup_delay =3*60; # don't send anything out until this timer has expired # this is to allow the feed to "warm up" with duplicates # so that the "big rush" doesn't happen. diff --git a/perl/Spot.pm b/perl/Spot.pm index 3d671d76..8b703306 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -330,11 +330,20 @@ sub search while (<$fh>) { my @r = split /\^/; ++$rec; + if ($dxchan) { + my ($gotone, undef) = $dxchan->{spotsfilter}->it(@r); + next unless $gotone; + } if (&$ecode(\@r)) { ++$count; next if $count < $from; - push @out, \@r; - last if $count >= $to; + if ($readback) { + push @out, \@r; + last if $count >= $to; + } else { + push @out, \@r; + shift @out if $count >= $to; + } } } dbg("Spot::search recs read: $rec") if isdbg('search'); @@ -384,24 +393,6 @@ sub formatl return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, ($_[3]||''), "<$_[4]" ; } -# -# return all the spots from a day's file as an array of references -# the parameter passed is a julian day -sub readfile($) -{ - my @spots; - - my $fh = $fp->open(shift); - if ($fh) { - my $in; - while (<$fh>) { - chomp; - push @spots, [ split '\^' ]; - } - } - return @spots; -} - # enter the spot for dup checking and return true if it is already a dup sub dup { -- 2.34.1