X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=24124f5a3184e6b826800cb036c40a2f79e9d77a;hb=refs%2Fheads%2Fstaging;hp=e9dd27901364080c84d982a0b29f1c5e1cb01eca;hpb=6eacc3d2fb49a6babfd77d8a0186c30968cb86ca;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index e9dd2790..24124f5a 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -238,10 +238,9 @@ sub prepare # remove ssids and /xxx if present on spotter $out[4] =~ s/-\d+$//o; - # remove leading and trailing spaces + # remove leading and trailing spaces from comment field $out[3] = unpad($out[3]); - # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call my @spd = Prefix::cty_data($out[1]); push @out, $spd[0]; @@ -348,6 +347,7 @@ sub search dbg("Spot::search hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n") if isdbg('search'); # build up eval to execute + dbg("Spot::search Spot eval: $expr") if isdbg('searcheval'); $expr =~ s/\$r/\$_[0]/g; my $eval = qq{ sub { return $expr; } }; @@ -355,7 +355,6 @@ sub search my $ecode = eval $eval; return ("Spot search error", $@) if $@; - my $fh; my $now = $fromdate; my $today = Julian::Day->new($main::systime); @@ -458,20 +457,31 @@ sub ftor # format a spot for user output in list mode sub formatl { - my $t = ztime($_[2]); - my $d = cldate($_[2]); - return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, ($_[3]||''), "<$_[4]" ; + my $t = ztime($_[3]); + my $d = cldate($_[3]); + my $spotter = "<$_[5]>"; + my $comment = $_[4] || ''; + $comment =~ s/\t+/ /g; + my $cl = length $comment; + my $s = sprintf "%9.1f %-11s %s %s", $_[1], $_[2], $d, $t; + my $width = ($_[0] ? $_[0] : 80) - length($spotter) - length($s) - 4; + + $comment = substr $comment, 0, $width if $cl > $width; + $comment .= ' ' x ($width-$cl) if $cl < $width; + +# return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, ($_[3]||''), "<$_[4]" ; + return "$s $comment$spotter"; } # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($freq, $call, $d, $text, $by, $cty) = @_; + my ($freq, $call, $d, $text, $by, $node, $just_find) = @_; # dump if too old return 2 if $d < $main::systime - $dupage; - - # turn the time into minutes (should be already but...) + + # turn the time into minutes (should be already but...) $d = int ($d / 60); $d *= 60; @@ -485,31 +495,32 @@ sub dup chomp $text; $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; $text = uc unpad($text); - if ($cty && $text && length $text <= 4) { - unless ($text =~ /^C?Q/ || $text =~ /^[\d\W]+$/) { - my @try = Prefix::cty_data($text); - $text = "" if $cty == $try[0]; - } - } my $otext = $text; # $text = Encode::encode("iso-8859-1", $text) if $main::can_encode && Encode::is_utf8($text, 1); $text =~ s/^\+\w+\s*//; # remove leading LoTW callsign $text =~ s/\s{2,}[\dA-Z]?[A-Z]\d?$// if length $text > 24; $text =~ s/[\W\x00-\x2F\x7B-\xFF]//g; # tautology, just to make quite sure! $text = substr($text, 0, $duplth) if length $text > $duplth; - my $ldupkey = "X$freq|$call|$by|$text"; + my $ldupkey = "X$|$call|$by|$node|$freq|$d|$text"; + my $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; - DXDupe::add($ldupkey, $main::systime+$dupage); + + DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find; $otext = substr($otext, 0, $duplth) if length $otext > $duplth; $otext =~ s/\s+$//; if (length $otext && $otext ne $text) { $ldupkey = "X$freq|$call|$by|$otext"; $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; - DXDupe::add($ldupkey, $main::systime+$dupage); + DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find; } - return 0; + return undef; +} + +sub dup_find +{ + return dup(@_, 1); } sub listdups @@ -517,11 +528,11 @@ sub listdups return DXDupe::listdups('X', $dupage, @_); } -sub genstats($) +sub genstats { my $date = shift; - my $in = $fp->open($date); - my $out = $statp->open($date, 'w'); + my $in = $fp->open($date) or dbg("Spot::genstats: Cannot open " . $fp->fn($date) . " $!"); + my $out = $statp->open($date, 'w') or dbg("Spot::genstats: Cannot open " . $statp->fn($date) . " $!"); my @freq; my %list; my @tot; @@ -564,7 +575,7 @@ sub genstats($) } # return true if the stat file is newer than than the spot file -sub checkstats($) +sub checkstats { my $date = shift; my $in = $fp->mtime($date);