X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRBN.pm;h=5898693e2b30ecc0cd05162ca490e82b39320e86;hb=44d90466304eae7d7aab0f375ac4c07a3f37b586;hp=9ff7dd48b9399c14fabda88659e88840c442ebd6;hpb=022cd402cfcb2db545d81cc6bc05552e02d639dc;p=spider.git diff --git a/perl/RBN.pm b/perl/RBN.pm index 9ff7dd48..5898693e 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -18,7 +18,7 @@ use DXUtil; use DXLog; use DXUser; use DXChannel; -use Math::Round qw(nearest); +use Math::Round qw(nearest nearest_floor); use Date::Parse; use Time::HiRes qw(gettimeofday); use Spot; @@ -58,6 +58,14 @@ use constant { CData => 2, }; +use constant { + DScore => 0, + DGood => 1, + DBad => 2, + DLastin => 3, + DEviants => 4, + }; + our $DATA_VERSION = 1; @@ -67,7 +75,7 @@ our $startup_delay = 5*60; # don't send anything out until this timer has expir # this is to allow the feed to "warm up" with duplicates # so that the "big rush" doesn't happen. -our $minspottime = 15*60; # the time between respots of a callsign - if a call is +our $minspottime = 30*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. @@ -91,6 +99,7 @@ our $minqual = 2; # the minimum quality we will accept for output my $json; my $noinrush = 0; # override the inrushpreventor if set +our $maxdeviants = 5; # the number of deviant QRGs to record for skimmer records sub init { @@ -294,36 +303,32 @@ 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 $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 $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well! # find it? my $cand = $spots->{$sp}; unless ($cand) { my ($i, $new); - for ($i = $tqrg; !$cand && $i <= $tqrg+$search; $i += 1) { + for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) { $new = "$call|$i"; $cand = $spots->{$new}, last if exists $spots->{$new}; } if ($cand) { - my $diff = $i - $tqrg; + my $diff = $i - $nqrg; 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) { + for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) { $new = "$call|$i"; $cand = $spots->{$new}, last if exists $spots->{$new}; } if ($cand) { - my $diff = $tqrg - $i; + my $diff = $nqrg - $i; dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || isdbg('rbn')); $sp = $new; } @@ -440,13 +445,9 @@ sub dx_spot my $quality = shift; my $cand = shift; my $call = $dxchan->{call}; - - my $strength = 100; # because it could if we talk about FTx my $saver; - my %zone; - my %qrg; my $respot; my $qra; @@ -461,19 +462,15 @@ sub dx_spot 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; + next unless $r && ref $r; - $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 - ++$zone{$s->[SZone]}; # save the spotter's zone - ++$qrg{$s->[SQrg]}; # and the qrg - # save the lowest strength one if ($r->[RStrength] < $strength) { @@ -501,21 +498,8 @@ sub dx_spot 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 - my $mv = 0; - my $fk; - my $c = 0; - while (my ($k, $v) = each %qrg) { - $fk = $k, $mv = $v if $v > $mv; - ++$c; - } - $saver->[SQrg] = $fk; - $saver->[SComment] .= '*' if $c > 1; - $saver->[SComment] .= '+' if $respot; + # alter spot data accordingly $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}) { @@ -553,13 +537,16 @@ 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; - + my $ta = [gettimeofday]; + my $items; + # now run the waiting queue which just contains KEYS ($call|$qrg) foreach my $sp (keys %{$dxchan->{queue}}) { my $cand = $spots->{$sp}; + ++$items; unless ($cand && $cand->[CTime]) { dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime"; next; @@ -567,45 +554,138 @@ sub process 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'; + dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue'; next; } dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue'; - my $r = $cand->[CData]; my $quality = @$cand - CData; + my $spotters = $quality; + + # dump it and remove it from the queue if it is of unadequate quality + if ($quality < $minqual) { + if (isdbg('rbnskim')) { + my $r = $cand->[CData]; + if ($r) { + my $s = "RBN: SPOT IGNORED(Q:$quality < Q:$minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] route: $dxchan->{call}"; + dbg($s); + } + } + delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed. + delete $dxchan->{queue}->{$sp}; + next; + } + $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); + my $r; + my %qrg; + my $skimmer; + my $sk; + my $band; + my %seen; + foreach $r (@$cand) { + next unless ref $r; + if (exists $seen{$r->[ROrigin]}) { + undef $r; + next; } - 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}"; + $seen{$r->[ROrigin]} = 1; + $band ||= int $r->[RQrg] / 1000; + $sk = "SKIM|$r->[ROrigin]|$band"; + $skimmer = $spots->{$sk}; + unless ($skimmer) { + $skimmer = $spots->{$sk} = [0+0, 0+0, 0+0, $now, []]; # this stupid incantation is to make sure than there are no JSON nulls! + dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if isdbg('rbnskim'); + } + $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1); + } + # determine the most likely qrg and then set it + my @deviant; + my $c = 0; + my $mv = 0; + my $qrg; + while (my ($k, $votes) = each %qrg) { + $qrg = $k, $mv = $votes if $votes >= $mv; + ++$c; + } + # spit out the deviants + foreach $r (@$cand) { + next unless $r && ref $r; + my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0; + $sk = "SKIM|$r->[ROrigin]|$band"; + $skimmer = $spots->{$sk}; + $skimmer->[DBad] ||= 0+0; # stop JSON nulls? + $skimmer->[DEviants] ||= []; # ditto + if ($diff) { + ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants; + --$skimmer->[DGood] if $skimmer->[DGood] > 0; + push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff); + push @{$skimmer->[DEviants]}, $diff; + shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants; + } else { + ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants; + --$skimmer->[DBad] if $skimmer->[DBad] > 0; + shift @{$skimmer->[DEviants]}; + } + $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad]; + $skimmer->[DScore] ||= 0.2; # minimun score + dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff " . $json->encode($skimmer)) if isdbg('rbnskim'); + $skimmer->[DLastin] = $now; + $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value + } + + + $qrg = (sprintf "%.1f", $qrg)+0; + $r = $cand->[CData]; + $r->[RQrg] = $qrg; + my $squality = "Q:$cand->[CQual]"; + $squality .= '*' if $c > 1; + $squality .= '+' if $r->[Respot]; + + if (isdbg('progress')) { + my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}"; + my $td = @deviant; + $s .= " QRGScore $mv Deviants ($td/$spotters): "; + $s .= join(', ', sort @deviant) if $td; dbg($s); } + + # finally send it out to any waiting public + send_dx_spot($dxchan, $squality, $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} = [$now, $cand->[CQual]]; + + delete $spots->{$sp}; delete $dxchan->{queue}->{$sp}; - } else { + + # calculate new sp (which will be 70% likely the same as the old one) + # we do this to cope with the fact that the first spotter may well be "wrongly calibrated" giving a qrg that disagrees with the majority. + # and we want to store the key that corresponds to majority opinion. + my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz + my $nsp = "$r->[RCall]|$nqrg"; + if ($sp ne $nsp) { + dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if isdbg('rbnskim'); + $spots->{$nsp} = [$now, $cand->[CQual]]; + } + } + else { dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue'; } } + if (isdbg('rbntimer')) { + my $diff = _diffus($ta); + dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS"; + } } - } 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'); + dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} retrieved spots: $dxchan->{norbn} delivered: $dxchan->{nospot} after filtering to 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; @@ -625,6 +705,7 @@ sub per_10_minute while (my ($k,$cand) = each %{$spots}) { next if $k eq 'VERSION'; next if $k =~ /^O\|/; + next if $k =~ /^SKIM\|/; if ($main::systime - $cand->[CTime] > $minspottime*2) { delete $spots->{$k}; @@ -638,7 +719,8 @@ sub per_10_minute foreach my $dxchan (DXChannel::get_all()) { next unless $dxchan->is_rbn; 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}}; + my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%'; + dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} retrieved spots: $dxchan->{norbn10} ($pc) delivered: $dxchan->{nospot10} after filtering to users: " . scalar keys %{$dxchan->{nousers10}}; $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {}; } } @@ -648,7 +730,8 @@ sub per_hour foreach my $dxchan (DXChannel::get_all()) { next unless $dxchan->is_rbn; 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}}; + my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%'; + dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} retrieved spots: $dxchan->{norbnhour} ($pc) delivered: $dxchan->{nospothour} after filtering to users: " . scalar keys %{$dxchan->{nousershour}}; $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {}; } } @@ -660,10 +743,19 @@ sub finish sub write_cache { - my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); - my $s = $json->encode($spots); - $fh->print($s); - $fh->close; + my $ta = [ gettimeofday ]; + $json->indent(1); + my $s = eval {$json->encode($spots)}; + if ($s) { + my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); + $fh->print($s); + $fh->close; + } else { + dbg("RBN:Write_cache error '$@'"); + } + $json->indent(0); + my $diff = _diffms($ta); + dbg("RBN:WRITE_CACHE time to write: $diff mS"); } sub check_cache @@ -693,6 +785,7 @@ sub check_cache while (my ($k, $cand) = each %$spots) { next if $k eq 'VERSION'; next if $k =~ /^O\|/; + next if $k =~ /^SKIM\|/; if (@$cand > CData) { $spots->{$k} = [$cand->[CTime], $cand->[CQual]]; } @@ -701,8 +794,8 @@ sub check_cache return 1; } } + dbg("RBN::checkcache error decoding $@"); } - dbg("RBN::checkcache error decoding $@"); } else { my $d = difft($main::systime-$cache_valid); dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");