fix !( spurious && before next item in Filter
authorDirk Koopman <djk@tobit.co.uk>
Sun, 31 May 2020 16:42:42 +0000 (17:42 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Sun, 31 May 2020 16:42:42 +0000 (17:42 +0100)
and some more RBN WIP

cmd/show/dx.pl
perl/Filter.pm
perl/RBN.pm

index c5d629ecd57e308a4cf2898bad59a6021ba9a6d4..07dbed15b26db32959794a04ce2375fc1e56c303 100644 (file)
@@ -5,28 +5,33 @@
 #
 
 require 5.10.1;
+use warnings;
 
 sub handle
 {
        my ($self, $line) = @_;
-       my @list = split /\s+/, $line; # split the line up
+
+       $line =~ s/([\(\!\)])/ $1 /g;
+       
+       my @list = split /[\s]+/, $line; # split the line up
 
        my @out;
        my $f;
        my $call = $self->call;
        my $usesql = $main::dbh && $Spot::use_db_for_search;
-       my ($from, $to);
-       my ($fromday, $today);
+       my ($from, $to) = (0, 0);
+       my ($fromday, $today) = (0, 0);
        my $exact;
        my $real;
-       my $user;
-       my $expr;
        my $dofilter;
        my $pre;
        my $dxcc;
 
        my @flist;
 
+       
+       dbg("sh/dx \@list: " . join(" ", @list)) if isdbg('sh/dx');
+       
        while ($f = shift @list) {      # next field
                dbg "sh/dx arg: $f list: " . join(',', @list) if isdbg('sh/dx');
                if (!$from && !$to) {
@@ -83,10 +88,16 @@ sub handle
                        dbg("sh/dx qra") if isdbg('sh/dx');
                        next;
                }
+               if (grep {lc $f eq $_} qw { ( or and not ) }) {
+                       push @flist, $f;
+                       dbg("sh/dx operator $f") if isdbg('sh/dx');
+                       next;
+               }
                if (grep {lc $f eq $_} qw(zone byzone by_zone itu byitu by_itu state bystate by_state info on spotter by) ) {
                        $f =~ s/^by(\w)/by_$1/;
                        push @flist, $f;
                        push @flist, shift @list if @list;
+                       dbg("sh/dx function $flist[-2] $flist[-1]") if isdbg('sh/dx');
                        next;
                }
                unless ($pre) {
@@ -116,7 +127,8 @@ sub handle
        my ($r, $filter, $fno, $user, $expr) = $Spot::filterdef->parse($self, 'spots', $newline, 1);
 
        return (0, "sh/dx parse error '$r' " . $filter) if $r;
-       
+
+       $user ||= '';
        dbg "sh/dx user: $user expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('sh/dx');
   
        # now do the search
index 2be5cd5bbb48537ed6d7d05333b799389cbf8ba7..fd9111826d209c25c1557b191cc1edd4f2048e08 100644 (file)
@@ -208,7 +208,7 @@ sub it
                if ($filter->{reject} && exists $filter->{reject}->{code}) {
                        $type = 'reject';
                        $asc = $filter->{reject}->{user};
-                       if (&{$filter->{reject}->{code}}(\@_)) {
+                       if (&{$filter->{reject}->{code}}(ref $_[0] ? $_[0] : \@_)) {
                                $r = 0;
                                last;
                        } else {
@@ -218,7 +218,7 @@ sub it
                if ($filter->{accept} && exists $filter->{accept}->{code}) {
                        $type = 'accept';
                        $asc = $filter->{accept}->{user};
-                       if (&{$filter->{accept}->{code}}(\@_)) {
+                       if (&{$filter->{accept}->{code}}(ref $_[0] ? $_[0] : \@_)) {
                                $r = 1;
                                last;
                        } else {
@@ -231,7 +231,7 @@ sub it
        my $hops = $self->{hops} if exists $self->{hops};
 
        if (isdbg('filter')) {
-               my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @_;
+               my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} (ref $_[0] ? @{$_[0]} : @_);
                my $true = $r ? "OK " : "REJ";
                my $sort = $self->{sort};
                my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT";
@@ -377,12 +377,13 @@ sub parse
        return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)\$!]/;
        
        # add some spaces for ease of parsing
-       $line =~ s/([\(\)])/ $1 /g;
+       $line =~ s/([\(\!\)])/ $1 /g;
        $line = lc $line;
        
        my @f = split /\s+/, $line;
        my $conj = ' && ';
        my $not = "";
+       my $lasttok = '';
        while (@f) {
                if ($ntoken == 0) {
                        
@@ -412,9 +413,12 @@ sub parse
                        my $tok = shift @f;
                        if ($tok eq '(') {
                                if ($s) {
-                                       $s .= $conj;
-                                       $user .= $conj;
+                                       unless ($lasttok eq '(') {
+                                               $s .= $conj ;
+                                               $user .= $conj;
+                                       }
                                        $conj = "";
+                                       $lasttok = $tok;
                                }
                                if ($not) {
                                        $s .= $not;
@@ -423,12 +427,14 @@ sub parse
                                }
                                $s .= $tok;
                                $user .= $tok;
+                               $lasttok = $tok;
                                next;
                        } elsif ($tok eq ')') {
                                $conj = ' && ';
                                $not ="";
                                $s .= $tok;
                                $user .= $tok;
+                               $lasttok = $tok;
                                next;
                        } elsif ($tok eq 'all') {
                                $s .= '1';
@@ -436,12 +442,14 @@ sub parse
                                last;
                        } elsif ($tok eq 'or') {
                                $conj = ' || ' if $conj ne ' || ';
+                               $lasttok = $tok;
                                next;
                        } elsif ($tok eq 'and') {
                                $conj = ' && ' if $conj ne ' && ';
                                next;
                        } elsif ($tok eq 'not' || $tok eq '!') {
-                               $not = '!';
+                               $not = '! ';
+                               $lasttok = $tok;
                                next;
                        }
                        if (@f) {
@@ -449,11 +457,12 @@ sub parse
                                my @val = split /,/, $val;
 
                                if ($s) {
-                                       $s .= $conj ;
-                                       $user .= $conj;
-                                       $conj = ' && ';
+                                       unless ($lasttok eq '(') {
+                                               $s .= $conj ;
+                                               $user .= $conj;
+                                               $conj = ' && ';
+                                       }
                                }
-
                                if ($not) {
                                        $s .= $not;
                                        $user .= $not;
@@ -528,8 +537,8 @@ sub parse
                        } else {
                                return ('no', $dxchan->msg('filter2', $tok));
                        }
+                       $lasttok = $tok;
                }
-               
        }
 
        # tidy up the user string
index a377d2c7818d22fcd7b113992725712758d9025a..81d161b2b003417b8dd1f1ab741fe1ff1652bd4f 100644 (file)
@@ -20,6 +20,35 @@ use Math::Round qw(nearest);
 
 our @ISA = qw(DXChannel);
 
+our $startup_delay = 0;# 2*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. 
+
+our $minspottime = 60*60;              # the time between respots of a callsign - if a call is
+                                # still being spotted (on the same freq) and it has been
+                                # spotted before, it's spotted again after this time
+                                # until the next minspottime has passed.
+
+our %hfitu = (
+                         1 => [1, 2,],
+                         2 => [1, 2, 3,],
+                         3 => [2,3, 4,],
+                         4 => [3,4, 9,],
+#                        5 => [0],
+                         6 => [7],
+                         7 => [7, 6, 8, 10],
+                         8 => [7, 8, 9],
+                         9 => [8, 9],
+                         10 => [10],
+                         11 => [11],
+                         12 => [12, 13],
+                         13 => [12, 13],
+                         14 => [14, 15],
+                         15 => [15, 14],
+                         16 => [16],
+                         17 => [17],
+                        );
+
 sub new 
 {
        my $self = DXChannel::alloc(@_);
@@ -37,7 +66,7 @@ sub new
        $self->{norbn} = 0;
        $self->{sort} = 'N';
        $self->{lasttime} = $main::systime;
-       $self->{minspottime} = 60*60;
+       $self->{minspottime} = $minspottime;
        $self->{showstats} = 0;
 
        return $self;
@@ -95,6 +124,9 @@ sub start
                my $long = $user->long;
                $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);  
        }
+
+       # start inrush timer
+       $self->{inrushpreventor} = $main::systime + $startup_delay;
 }
 
 sub normal
@@ -205,10 +237,14 @@ sub normal
                        my $tag = $ts ? "RESPOT" : "SPOT";
                        $t .= ",$b" if $b;
                        $sort ||= '';
-                       dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
+                       $origin =~ s/-?\d+?-?\#?\s*$//;
+                       
+                       dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if dbg('rbn');
 
-                       send_dx_spot($self, $line, $mode);
+                       my @s = Spot::prepare($qrg, $call, $t, "$mode $s $m", $origin);
                        
+                       send_dx_spot($self, $line, $mode, \@s) unless $self->{inrushpreventor} > $main::systime;
+
                        $spot->{$sp} = $tim;
                }
        } else {
@@ -254,6 +290,7 @@ sub send_dx_spot
        my $self = shift;
        my $line = shift;
        my $mode = shift;
+       my $sref = shift;
        
        my @dxchan = DXChannel::get_all();
 
@@ -272,10 +309,65 @@ sub send_dx_spot
 
                ++$want unless $want;   # send everything if nothing is selected.
 
-               $dxchan->send($line) if $want;
+               
+               $self->dx_spot($dxchan, $sref) if $want;
                dbg("RBN: $line") if isdbg('progress');
        }
 }
 
+sub dx_spot
+{
+       my $self = shift;
+       my $dxchan = shift;
+       my $sref = shift;
+       
+#      return unless $dxchan->{rbn};
+
+       my ($filter, $hops);
+
+       if ($dxchan->{rbnfilter}) {
+               ($filter, $hops) = $dxchan->{rbnfilter}->it($sref);
+               return unless $filter;
+       } elsif ($self->{rbnfilter}) {
+               ($filter, $hops) = $self->{rbnfilter}->it($sref);
+               return unless $filter;
+       }
+
+       dbg('RBN::dx_spot spot: "' . join('","', @$sref) . '"') if isdbg('rbn');
 
+       my $buf;
+       if ($self->{ve7cc}) {
+               $buf = VE7CC::dx_spot($dxchan, @$sref);
+       } else {
+               $buf = $self->format_dx_spot(@$sref);
+               $buf =~ s/\%5E/^/g;
+       }
+
+       $dxchan->local_send('N', $buf);
+}
+
+sub format_dx_spot
+{
+       my $self = shift;
+
+       my $t = ztime($_[2]);
+       my $loc = '';
+       my $clth = $self->{consort} eq 'local' ? 29 : 30;
+       my $comment = $_[3] || '';
+       my $ref = DXUser::get_current($_[1]);
+       if ($ref) {
+               $loc = $ref->qra;
+               $loc = ' ' . substr($loc, 0, 4) if $loc;
+       }
+       $comment .= ' ' x ($clth - (length($comment)+length($loc)));
+       $comment .= $loc if $loc;
+       $loc = '';
+       $ref = DXUser::get_current($_[4]);
+       if ($ref) {
+               $loc = $ref->qra;
+               $loc = ' ' . substr($loc, 0, 4) if $loc;
+               $loc ||= '';
+       }
+       return sprintf "RB de %7.7s:%11.1f  %-12.12s %-s $t$loc", $_[4], $_[0], $_[1], $comment;
+}
 1;