X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRBN.pm;h=d9fbe053f5d20960d6eb2c3397e2b1e5af059126;hb=17b1614af3840c2c74bee181290eb094f8ed4a00;hp=8d5db6aaedb9d5894f3aec59f4986d1413931adc;hpb=811077a3d45e4f89012a9169061745b0b42fe97b;p=spider.git diff --git a/perl/RBN.pm b/perl/RBN.pm index 8d5db6aa..d9fbe053 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -46,15 +46,28 @@ use constant { SOrigin => 4, SZone => 11, }; +use constant { + OQual => 0, + OAvediff => 1, + OSpare => 2, + ODiff => 3, + }; +use constant { + CTime => 0, + CQual => 1, + CData => 2, + }; + + +our $DATA_VERSION = 1; - our @ISA = qw(DXChannel); our $startup_delay = 5*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 +our $minspottime = 15*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. @@ -73,20 +86,25 @@ my %runtime; # how long each channel has been running our $cachefn = localdata('rbn_cache'); our $cache_valid = 4*60; # The cache file is considered valid if it is not more than this old +our $maxqrgdiff = 10; # the maximum +our $minqual = 2; # the minimum quality we will accept for output + my $json; my $noinrush = 0; # override the inrushpreventor if set sub init { $json = DXJSON->new; - $spots = {}; if (check_cache()) { $noinrush = 1; + } else { + $spots = {VERSION=>$DATA_VERSION}; } if (defined $DB::VERSION) { $noinrush = 1; $json->indent(1); } + } sub new @@ -117,6 +135,7 @@ sub new $self->{showstats} = 0; $self->{pingint} = 0; $self->{nopings} = 0; + $self->{queue} = {}; return $self; } @@ -196,7 +215,7 @@ sub normal # add base RBN - my $tim = $main::systime; + my $now = $main::systime; # parse line dbg "RBN:RAW,$line" if isdbg('rbnraw'); @@ -275,41 +294,64 @@ sub normal # process to just the standard "message passing" which has been shown to be able to sustain over 5000 # per second (limited by the test program's output and network speed, rather than DXSpider's handling). - my $nqrg = nearest(1, $qrg); # normalised to nearest Khz + my $nearest = 1; + my $search = 5; + my $mult = 10; + my $tqrg = $qrg * $mult; + my $nqrg = nearest($nearest, $tqrg); # normalised to nearest Khz # my $nqrg = nearest_even($qrg); # normalised to nearest Khz my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well! - my $spp = sprintf("$call|%d", $nqrg+1); # but, clearly, my hopes are rudely dashed - my $spm = sprintf("$call|%d", $nqrg-1); # in BOTH directions! - # do we have it? - my $spot = $spots->{$sp}; - $spot = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if isdbg('rbn') && !$spot && exists $spots->{$spp}; - $spot = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if isdbg('rbn') && !$spot && exists $spots->{$spm}; + # find it? + my $cand = $spots->{$sp}; + unless ($cand) { + my ($i, $new); + for ($i = $tqrg; !$cand && $i <= $tqrg+$search; $i += 1) { + $new = "$call|$i"; + $cand = $spots->{$new}, last if exists $spots->{$new}; + } + if ($cand) { + my $diff = $i - $tqrg; + dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || isdbg('rbn')); + $sp = $new; + } + } + unless ($cand) { + my ($i, $new); + for ($i = $tqrg; !$cand && $i >= $tqrg-$search; $i -= 1) { + $new = "$call|$i"; + $cand = $spots->{$new}, last if exists $spots->{$new}; + } + if ($cand) { + my $diff = $tqrg - $i; + dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || isdbg('rbn')); + $sp = $new; + } + } - # if we have one and there is only one slot and that slot's time isn't expired for respot then return my $respot = 0; - if ($spot && ref $spot) { - if (@$spot == 1) { - unless ($self->{minspottime} > 0 && $tim - $spot->[0] >= $self->{minspottime}) { - dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $spot->[0])) if isdbg('rbn'); + if ($cand && ref $cand) { + if (@$cand <= CData) { + unless ($self->{minspottime} > 0 && $now - $cand->[CTime] >= $self->{minspottime}) { + dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if isdbg('rbn'); return; } - dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $spot->[0])) if isdbg('rbn'); - undef $spot; # it's about to be recreated (in one place) + dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if isdbg('rbn'); + $cand->[CTime] = $now; ++$respot; } # otherwise we have a spot being built up at the moment - } elsif ($spot) { - dbg("RBN: key '$sp' = '$spot' not ref"); + } elsif ($cand) { + dbg("RBN: key '$sp' = '$cand' not ref"); return; } # here we either have an existing spot record buildup on the go, or we need to create the first one - unless ($spot) { - $spots->{$sp} = $spot = [$main::systime]; + unless ($cand) { + $spots->{$sp} = $cand = [$now, 0]; dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if isdbg('rbn'); } @@ -320,7 +362,7 @@ sub normal # deal with the unix time my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/; my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day - $utz -= 86400 if $utz > $tim+3600; # too far ahead, drag it back one day + $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day # create record and add into the buildup my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u]; @@ -336,51 +378,12 @@ sub normal } $r->[RSpotData] = \@s; - push @{$self->{queue}}, $sp if @$spot == 1; # queue the KEY (not the record) + ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record) dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn'); - push @$spot, $r; + push @$cand, $r; - # At this point we run the queue to see if anything can be sent onwards to the punter - my $now = $main::systime; - - # now run the waiting queue which just contains KEYS ($call|$qrg) - foreach $sp (@{$self->{queue}}) { - my $cand = $spots->{$sp}; - unless ($cand && $cand->[0]) { - dbg "RBN Cand " . ($cand ? 'def' : 'undef') . " [0] " . ($cand->[0] ? 'def' : 'undef') . " dwell $dwelltime"; - next; - } - if ($now >= $cand->[0] + $dwelltime ) { - # we have a candidate, create qualitee value(s); - unless (@$cand > 1) { - dbg "RBN: QUEUE key '$sp' MISSING RECORDS " . dd($cand) if isdbg 'rbn'; - shift @{$self->{queue}}; - next; - } - my $savedtime = shift @$cand; # save the start time - my $r = $cand->[0]; - my $quality = @$cand; - $quality = 9 if $quality > 9; - $quality = "Q:$quality"; - if (isdbg('progress')) { - my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $quality"; - $s .= " route: $self->{call}"; - dbg($s); - } - - send_dx_spot($self, $quality, $cand); - - # clear out the data and make this now just "spotted", but no further action required until respot time - dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn'; - - $spots->{$sp} = [$savedtime]; - shift @{$self->{queue}}; - } else { - dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $spot->[0] + $dwelltime - $now) if isdbg 'rbnqueue'; - } - } } else { dbg "RBN:DATA,$line" if isdbg('rbn'); } @@ -391,7 +394,7 @@ sub send_dx_spot { my $self = shift; my $quality = shift; - my $spot = shift; + my $cand = shift; ++$self->{norbn}; ++$self->{norbn10}; @@ -399,7 +402,7 @@ sub send_dx_spot # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot]; - my $mode = $spot->[0]->[3]; # as all the modes will be the same; + my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same; my @dxchan = DXChannel::get_all(); @@ -426,7 +429,7 @@ sub send_dx_spot )) if isdbg('rbnll'); # send one spot to one user out of the ones that we have - $self->dx_spot($dxchan, $quality, $spot) if $want; + $self->dx_spot($dxchan, $quality, $cand) if $want; } } @@ -435,7 +438,7 @@ sub dx_spot my $self = shift; my $dxchan = shift; my $quality = shift; - my $spot = shift; + my $cand = shift; my $call = $dxchan->{call}; @@ -453,14 +456,17 @@ sub dx_spot my $filtered; my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter}; - foreach my $r (@$spot) { + my $comment; + + foreach my $r (@$cand) { # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra]; # Spot::prepare($qrg, $call, $utz, $comment, $origin); + next unless ref $r; - my $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength]; $respot = 1 if $r->[Respot]; $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]); + $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength]; my $s = $r->[RSpotData]; # the prepared spot $s->[SComment] = $comment; # apply new generated comment @@ -507,6 +513,9 @@ sub dx_spot $saver->[SComment] .= '*' if $c > 1; $saver->[SComment] .= '+' if $respot; $saver->[SComment] .= " Z:$z" if $z; + if ($c > 1 && (isdbg('rbnqrg') || isdbg('rbn'))) { + + } dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll'; if ($dxchan->{ve7cc}) { @@ -539,6 +548,58 @@ sub dx_spot } } +# per second +sub process +{ + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + + # At this point we run the queue to see if anything can be sent onwards to the punter + my $now = $main::systime; + + # now run the waiting queue which just contains KEYS ($call|$qrg) + foreach my $sp (keys %{$dxchan->{queue}}) { + my $cand = $spots->{$sp}; + unless ($cand && $cand->[CTime]) { + dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime"; + next; + } + if ($now >= $cand->[CTime] + $dwelltime ) { + # we have a candidate, create qualitee value(s); + unless (@$cand > CData) { + dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbn'; + next; + } + dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue'; + my $r = $cand->[CData]; + my $quality = @$cand - CData; + $quality = 9 if $quality > 9; + $cand->[CQual] = $quality if $quality > $cand->[CQual]; + my $squality = "Q:$cand->[CQual]"; + + if ($cand->[CQual] >= $minqual) { + if (isdbg('progress')) { + my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}"; + dbg($s); + } + send_dx_spot($dxchan, $squality, $cand); + } elsif (isdbg('rbn')) { + my $s = "RBN: SPOT IGNORED(Q $cand->[CQual] < $minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}"; + dbg($s); + } + + # clear out the data and make this now just "spotted", but no further action required until respot time + dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn'; + + $spots->{$sp} = [$now, $cand->[CQual]]; + delete $dxchan->{queue}->{$sp}; + } else { + dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue'; + } + } + } + +} sub per_minute { @@ -561,8 +622,8 @@ sub per_10_minute { my $count = 0; my $removed = 0; - while (my ($k,$v) = each %{$spots}) { - if ($main::systime - $v->[0] > $minspottime*2) { + while (my ($k,$cand) = each %{$spots}) { + if ($main::systime - $cand->[CTime] > $minspottime*2) { delete $spots->{$k}; ++$removed; } @@ -573,7 +634,8 @@ sub per_10_minute dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn'); foreach my $dxchan (DXChannel::get_all()) { next unless $dxchan->is_rbn; - dbg "RBN:STATS 10-minute $dxchan->{call} raw: $dxchan->{noraw10} sent: $dxchan->{norbn10} delivered: $dxchan->{nospot10} users: " . scalar keys %{$dxchan->{nousers10}}; + my $nq = keys %{$dxchan->{queue}}; + dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} sent: $dxchan->{norbn10} delivered: $dxchan->{nospot10} users: " . scalar keys %{$dxchan->{nousers10}}; $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {}; } } @@ -582,7 +644,8 @@ sub per_hour { foreach my $dxchan (DXChannel::get_all()) { next unless $dxchan->is_rbn; - dbg "RBN:STATS hour $dxchan->{call} raw: $dxchan->{norawhour} sent: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} users: " . scalar keys %{$dxchan->{nousershour}}; + my $nq = keys %{$dxchan->{queue}}; + dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} sent: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} users: " . scalar keys %{$dxchan->{nousershour}}; $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {}; } } @@ -621,9 +684,18 @@ sub check_cache } if ($s) { eval {$spots = $json->decode($s)}; - if ($spots && ref $spots) { - dbg("RBN:check_cache spot cache restored"); - return 1; + if ($spots && ref $spots) { + if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) { + # now clean out anything that is current + while (my ($k, $cand) = each %$spots) { + next unless ref $cand; + if (@$cand > CData) { + $spots->{$k} = [$cand->[CTime], $cand->[CQual]]; + } + } + dbg("RBN:check_cache spot cache restored"); + return 1; + } } } dbg("RBN::checkcache error decoding $@");