fix sh/mydx, add back qra sq for sh/dxgrid

diff --git a/Changes b/Changes
index fd5711ae4414a2d408a0d9efb3298949000516b1..6cdc906a0d9e39ccb8d76951172f8de4b784e1b4 100644 (file)
--- 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 641f977bc1774deaf7014c98ca7aaaa3606f05eb..ab3f27a2438d0592b51a6b65427f8f6f002eedd3 100644 (file)
--- 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 94fbb7d84f97dfe4eaab5db3de78072fc86415d9..baca1f68fe2cfcb5a924a07eac739d09eebaddb3 100644 (file)
--- 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 8bb6659e5f0f7fb70e849fb30da9b9150b94e6a9..900460aef2c1df89f65fb48b1a97fd1ef7bb3eeb 100644 (file)
--- 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 b33f882384e63d161a18ecd0a8cfecca2f3b4837..5d212b078e220388de8b4bbef8e23b9a10e9d240 100644 (file)
--- 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 d86c36d55a58ea1a82b7f292f8c885330fffec68..5084a69530c3bbfe126b66d7cbed25e1d27088e0 100644 (file)
--- 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 37afddf7c075e7d00efefb143e0585d4b58bdc2f..659178fbbd09c5b86d3bcd7cc92d370cc9c973f3 100644 (file)
--- 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 30667d61b48abb160595cfbc54f862af1e9490c1..ba81f735a79ec0f10858eaa19e58e6e2636741c9 100644 (file)
--- 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 3d671d76ae0c90f20a54050b37498f98fc703120..8b703306e25e0f1b94f86c1bbbddabca0a2a70e1 100644 (file)
--- 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
 {