X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRBN.pm;h=03efc0d380734b575eac63007196e40c7af0305b;hb=4eb47d73bc2221bde7a1dd761cef99e84b0bb388;hp=418c1cb357e45947baa9779f441cd5651fc72234;hpb=29e86370c5f331ae3d2c6f85e7001a7d2e758137;p=spider.git diff --git a/perl/RBN.pm b/perl/RBN.pm index 418c1cb3..03efc0d3 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -11,6 +11,8 @@ package RBN; use 5.10.1; +use lib qw {.}; + use DXDebug; use DXUtil; use DXLog; @@ -18,11 +20,60 @@ use DXUser; use DXChannel; use Math::Round qw(nearest); use Date::Parse; -use Time::HiRes qw(clock_gettime CLOCK_REALTIME); +use Time::HiRes qw(gettimeofday); use Spot; -use JSON; +use DXJSON; use IO::File; +use constant { + ROrigin => 0, + RQrg => 1, + RCall => 2, + RMode => 3, + RStrength => 4, + RTime => 5, + RUtz => 6, + Respot => 7, + RQra => 8, + }; + +# at least one whole spot per cache entry is necessary +use constant { + SQrg => 0, + SCall => 1, + STime => 2, + SComment => 3, + SOrigin => 4, + SODxcc => 6, + SOItu => 8, + SOZone => 11, + SOState => 13, + SQra => 15, # i.e. extra after the IP address + }; + + +# Standard Cache entries +# key Spot|normalised freq +use constant { + CTime => 0, # time of latest spot in a tranch + CQual => 1, # Qualitee + CSpot => 3, # the Spot::Prepare data for this spot + CSkims => 3, # the list of skimmers (hcalls) is [[...]...] + }; + + + +# key SK| +use constant { + SKTime =>0, # last time seen + SKOffset => 1, + SKQual => 2, + SKSpot =>3, # the Spot::Prepare data for this skimmer + }; + + +our $CACHE_VERSION = 2; + our @ISA = qw(DXChannel); our $startup_delay = 5*60; # don't send anything out until this timer has expired @@ -53,7 +104,7 @@ my $noinrush = 0; # override the inrushpreventor if set sub init { - $json = JSON->new; + $json = DXJSON->new; $spots = {}; if (check_cache()) { $noinrush = 1; @@ -164,9 +215,6 @@ sub normal my @ans; # my $spots = $self->{spot}; - # save this for them's that need it - my $rawline = $line; - # remove leading and trailing spaces chomp $line; $line =~ s/^\s*//; @@ -207,7 +255,7 @@ sub normal ++$self->{norawhour}; my $b; - + if ($t || $tx) { # fix up times for things like 'NXDXF B' etc @@ -253,40 +301,40 @@ 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 $nqrg = nearest(5, $qrg*10); # normalised to nearest .5 Khz (but multipled by 10 to get an integer) +# 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}; - + my $cand = $spots->{$sp}; + $cand = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if isdbg('rbn') && !$cand && exists $spots->{$spp}; + $cand = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if isdbg('rbn') && !$cand && exists $spots->{$spm}; # 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 <= CEMPTY) { + unless ($self->{minspottime} > 0 && $tim - $cand->[0] >= $self->{minspottime}) { + dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[0])) 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->[0])) if isdbg('rbn'); + undef $cand; # it's about to be recreated (in one place) ++$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 = [clock_gettime(CLOCK_REALTIME)];; + unless ($cand) { + $spots->{$sp} = $cand = [$main::systime, 0, 0]; dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if isdbg('rbn'); } @@ -301,26 +349,38 @@ sub normal # create record and add into the buildup my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u]; - my @s = Spot::prepare($r->[1], $r->[2], $r->[6], '', $r->[0]); - if ($s[5] == 666) { - dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped"); - return; + unless ($cand->[CSpot]) { + my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]); + if ($s[5] == 666) { + dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped"); + return; + } + $cand->[CSpot] = \@s; } if ($self->{inrbnfilter}) { my ($want, undef) = $self->{inrbnfilter}->it($s); return unless $want; } - $r->[9] = \@s; - push @{$self->{queue}}, $sp if @$spot == 1; # queue the KEY (not the record) + # add/set up the skimmer record + my $skimkey = "SK|$origin"; + my $skim = $spots->{$skimkey}; + unless ($skim) { + my $ur = DXUser::get($origin); + $spots->{$skimkey} = [$main::systime, 0, 0, $s->[SODxcc], $s->[SOItu], $s->[SOZone], $s->[SOState], ($ur ? $ur->qra : undef) ]; + } + + + + push @{$self->{queue}}, $sp if @$cand == 1; # 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 = clock_gettime(CLOCK_REALTIME); + my $now = $main::systime; # now run the waiting queue which just contains KEYS ($call|$qrg) foreach $sp (@{$self->{queue}}) { @@ -329,9 +389,9 @@ sub normal dbg "RBN Cand " . ($cand ? 'def' : 'undef') . " [0] " . ($cand->[0] ? 'def' : 'undef') . " dwell $dwelltime"; next; } - if ($now >= $cand->[0] + $dwelltime ) { + if ($now >= $cand->[CTime] + $dwelltime ) { # we have a candidate, create qualitee value(s); - unless (@$cand > 1) { + unless (@$cand > CEMPTY) { dbg "RBN: QUEUE key '$sp' MISSING RECORDS " . dd($cand) if isdbg 'rbn'; shift @{$self->{queue}}; next; @@ -342,7 +402,7 @@ sub normal $quality = 9 if $quality > 9; $quality = "Q:$quality"; if (isdbg('progress')) { - my $s = "RBN: SPOT key: '$sp' = $r->[2] on $r->[1] by $r->[0] \@ $r->[5] $quality"; + my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $quality"; $s .= " route: $self->{call}"; dbg($s); } @@ -355,7 +415,7 @@ sub normal $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'; + dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[0] + $dwelltime - $now) if isdbg 'rbnqueue'; } } } else { @@ -363,59 +423,12 @@ sub normal } } -sub per_minute -{ - foreach my $dxchan (DXChannel::get_all()) { - next unless $dxchan->is_rbn; - dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} sent: $dxchan->{norbn} delivered: $dxchan->{nospot} users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats'); - if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) { - LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting"); - $dxchan->disconnect; - } - $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {}; - $runtime{$dxchan->{call}} += 60; - } - - # save the spot cache - write_cache() unless $main::systime + $startup_delay < $main::systime;; -} - -sub per_10_minute -{ - my $count = 0; - my $removed = 0; - while (my ($k,$v) = each %{$spots}) { - if ($main::systime - $v->[0] > $minspottime*2) { - delete $spots->{$k}; - ++$removed; - } - else { - ++$count; - } - } - 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}}; - $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {}; - } -} - -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}}; - $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {}; - } -} - # we should get the spot record minus the time, so just an array of record (arrays) sub send_dx_spot { my $self = shift; my $quality = shift; - my $spot = shift; + my $cand = shift; ++$self->{norbn}; ++$self->{norbn10}; @@ -423,7 +436,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->[0]->[3]; # as all the modes will be the same; my @dxchan = DXChannel::get_all(); @@ -450,7 +463,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; } } @@ -459,7 +472,7 @@ sub dx_spot my $self = shift; my $dxchan = shift; my $quality = shift; - my $spot = shift; + my $cand = shift; my $call = $dxchan->{call}; @@ -474,45 +487,49 @@ sub dx_spot ++$self->{nousers}->{$call}; ++$self->{nousers10}->{$call}; ++$self->{nousershour}->{$call}; - - foreach my $r (@$spot) { + + my $filtered; + my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter}; + foreach my $r (@$cand) { # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra]; # Spot::prepare($qrg, $call, $utz, $comment, $origin); - my $comment = sprintf "%-3s %2ddB $quality", $r->[3], $r->[4]; - $respot = 1 if $r->[7]; - $qra = $r->[8] if !$qra && $r->[8] && is_qra($r->[8]); + 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]); - my $s = $r->[9]; # the prepared spot - $s->[3] = $comment; # apply new generated comment + my $s = $r->[RSpotData]; # the prepared spot + $s->[SComment] = $comment; # apply new generated comment - ++$zone{$s->[11]}; # save the spotter's zone - ++$qrg{$s->[0]}; # and the qrg + ++$zone{$s->[SZone]}; # save the spotter's zone + ++$qrg{$s->[SQrg]}; # and the qrg - my $want = 0; - my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter}; - if ($rf) { - ($want, undef) = $rf->it($s); - next unless $want; + # save the lowest strength one + if ($r->[RStrength] < $strength) { + $strength = $r->[RStrength]; $saver = $s; - dbg("RBN: FILTERED call: $s->[1] qrg: $s->[0] origin: $s->[4] dB: $r->[4]") if isdbg 'rbn'; - last; + dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll'; } - # save the lowest strength one - if ($r->[4] < $strength) { - $strength = $r->[4]; - $saver = $s; - dbg("RBN: STRENGTH call: $s->[1] qrg: $s->[0] origin: $s->[4] dB: $r->[4]") if isdbg 'rbn'; + if ($rf && !$want) { + my ($want, undef) = $rf->it($s); + dbg("RBN: FILTERING for $call spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] com: '$s->[SComment]' want: " . ($want ? 'YES':'NO')) if isdbg 'rbnll'; + next unless $want; + $filtered = $s; +# last; } } + if ($rf) { + $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef ! + } + if ($saver) { my $buf; # create a zone list of spotters - delete $zone{$saver->[11]}; # remove this spotter's zone (leaving all the other zones) + delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones) my $z = join ',', sort {$a <=> $b} keys %zone; # determine the most likely qrg and then set it @@ -523,23 +540,23 @@ sub dx_spot $fk = $k, $mv = $v if $v > $mv; ++$c; } - $saver->[0] = $fk; - $saver->[3] .= '*' if $c > 1; - $saver->[3] .= '+' if $respot; - $saver->[3] .= " Z:$z" if $z; + $saver->[SQrg] = $fk; + $saver->[SComment] .= '*' if $c > 1; + $saver->[SComment] .= '+' if $respot; + $saver->[SComment] .= " Z:$z" if $z; - dbg("RBN: SENDING call: $saver->[1] qrg: $saver->[0] origin: $saver->[4] $saver->[3]") if isdbg 'rbn'; + dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll'; if ($dxchan->{ve7cc}) { - my $call = $saver->[4]; - $saver->[4] .= '-#'; + my $call = $saver->[SOrigin]; + $saver->[SOrigin] .= '-#'; $buf = VE7CC::dx_spot($dxchan, @$saver); - $saver->[4] = $call; + $saver->[SOrigin] = $call; } else { - my $call = $saver->[4]; - $saver->[4] = substr($call, 0, 6); - $saver->[4] .= '-#'; + my $call = $saver->[SOrigin]; + $saver->[SOrigin] = substr($call, 0, 6); + $saver->[SOrigin] .= '-#'; $buf = $dxchan->format_dx_spot(@$saver); - $saver->[4] = $call; + $saver->[SOrigin] = $call; } # $buf =~ s/^DX/RB/; $dxchan->local_send('N', $buf); @@ -549,16 +566,64 @@ sub dx_spot ++$self->{nospothour}; if ($qra) { - my $user = DXUser::get_current($saver->[1]) || DXUser->new($saver->[1]); + my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]); unless ($user->qra && is_qra($user->qra)) { $user->qra($qra); - dbg("RBN: update qra on $saver->[1] to $qra"); + dbg("RBN: update qra on $saver->[SCall] to $qra"); $user->put; } } } } + +sub per_minute +{ + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} sent: $dxchan->{norbn} delivered: $dxchan->{nospot} users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats'); + if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) { + LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting"); + $dxchan->disconnect; + } + $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {}; + $runtime{$dxchan->{call}} += 60; + } + + # save the spot cache + write_cache() unless $main::systime + $startup_delay < $main::systime;; +} + +sub per_10_minute +{ + my $count = 0; + my $removed = 0; + while (my ($k,$v) = each %{$spots}) { + if ($main::systime - $v->[0] > $minspottime*2) { + delete $spots->{$k}; + ++$removed; + } + else { + ++$count; + } + } + 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}}; + $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {}; + } +} + +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}}; + $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {}; + } +} + sub finish { write_cache(); @@ -567,6 +632,7 @@ sub finish sub write_cache { my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); + $spots->{version} = $CACHE_VERSION; my $s = $json->encode($spots); $fh->print($s); $fh->close; @@ -594,6 +660,13 @@ sub check_cache if ($s) { eval {$spots = $json->decode($s)}; if ($spots && ref $spots) { + my $version = $spots->{version} || 0; + unless ($version != $CACHE_VERSION) { + # wrong version number + dbg("RBN:check_cache version number mismatch got: $version want: $CACHE_VERSION, reseting"); + $spots = {}; + return undef; + } dbg("RBN:check_cache spot cache restored"); return 1; }