From d39d2e24fb9497d577080e8d0317794e096c27f4 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sun, 31 May 2020 17:42:42 +0100 Subject: [PATCH] fix !( spurious && before next item in Filter and some more RBN WIP --- cmd/show/dx.pl | 24 +++++++++--- perl/Filter.pm | 33 ++++++++++------ perl/RBN.pm | 100 +++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 135 insertions(+), 22 deletions(-) diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index c5d629ec..07dbed15 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -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 diff --git a/perl/Filter.pm b/perl/Filter.pm index 2be5cd5b..fd911182 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -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 diff --git a/perl/RBN.pm b/perl/RBN.pm index a377d2c7..81d161b2 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -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; -- 2.43.0