X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=b8efd3d17c7af576ef387c908e41acfbb3eef8d5;hb=cd5b993f99b52d3c3c51779e9ea1fa150232225e;hp=95b7e902d8db2cf6f8f3aa9d5f455eed803674ea;hpb=e1c6972cba6f7d60e2b9c44a6c38a747804cab1b;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index 95b7e902..b8efd3d1 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -3,7 +3,7 @@ # # Copyright (c) - 1998 Dirk Koopman G1TLH # -# $Id$ +# # package Spot; @@ -21,13 +21,8 @@ use QSL; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots $maxcalllth); +use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef + $totalspots $hfspots $vhfspots $maxcalllth $can_encode $use_db_for_search); $fp = undef; $statp = undef; @@ -58,6 +53,7 @@ $filterdef = bless ([ ], 'Filter::Cmd'); $totalspots = $hfspots = $vhfspots = 0; +$use_db_for_search = 0; # create a Spot Object sub new @@ -103,6 +99,58 @@ sub init mkdir "$dirprefix", 0777 if !-e "$dirprefix"; $fp = DXLog::new($dirprefix, "dat", 'd'); $statp = DXLog::new($dirprefix, "dys", 'd'); + + # load up any old spots + if ($main::dbh) { + unless (grep $_ eq 'spot', $main::dbh->show_tables) { + dbg('initialising spot tables'); + my $t = time; + my $total; + $main::dbh->spot_create_table; + + my $now = Julian::Day->alloc(1995, 0); + my $today = Julian::Day->new(time); + my $sth = $main::dbh->spot_insert_prepare; + $main::dbh->{RaiseError} = 0; + while ($now->cmp($today) <= 0) { + my $fh = $fp->open($now); + if ($fh) { + my $count = 0; + while (<$fh>) { + chomp; + my @s = split /\^/; + if (@s < 12) { + my @a = (Prefix::cty_data($s[1]))[1..3]; + my @b = (Prefix::cty_data($s[4]))[1..3]; + push @s, $b[1] if @s < 7; + push @s, '' if @s < 8; + push @s, @a[0,1], @b[0,1] if @s < 12; + push @s, $a[2], $a[2] if @s < 14; + } + + push @s, undef while @s < 14; + pop @s while @s > 14; + + $main::dbh->spot_insert(\@s, $sth); + $count++; + } + $main::dbh->commit if $count; + $main::dbh->{RaiseError} = 0; + dbg("inserted $count spots from $now->[0] $now->[1]"); + $fh->close; + $total += $count; + } + $now = $now->add(1); + } + $main::dbh->spot_add_indexes; + $main::dbh->commit; + $main::dbh->{RaiseError} = 1; + $t = time - $t; + my $min = int($t / 60); + my $sec = $t % 60; + dbg("$total spots converted in $min:$sec"); + } + } } sub prefix @@ -113,17 +161,17 @@ sub prefix # fix up the full spot data from the basic spot data sub prepare { - # $freq, $call, $t, $comment, $spotter = @_ + # $freq, $call, $t, $comment, $spotter, node, ip address = @_ my @out = @_[0..4]; # just up to the spotter # normalise frequency - $_[0] = sprintf "%.1f", $_[0]; + $out[0] = sprintf "%.1f", $out[0]; # remove ssids and /xxx if present on spotter $out[4] =~ s/-\d+$//o; # remove leading and trailing spaces - $_[3] = unpad($_[3]); + $out[3] = unpad($out[3]); # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call @@ -132,13 +180,19 @@ sub prepare my @spt = Prefix::cty_data($out[4]); push @out, $spt[0]; push @out, $_[5]; - return (@out, @spd[1,2], @spt[1,2], $spd[3], $spt[3]); + push @out, @spd[1,2], @spt[1,2], $spd[3], $spt[3]; + push @out, $_[6] if $_[6] && is_ipaddr($_[6]); + return @out; } sub add { my $buf = join('^', @_); $fp->writeunix($_[2], $buf); + if ($main::dbh) { + $main::dbh->spot_insert(\@_); + $main::dbh->commit; + } $totalspots++; if ($_[0] <= 30000) { $hfspots++; @@ -200,6 +254,10 @@ sub search $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0; + if ($main::dbh && $use_db_for_search) { + return $main::dbh->spot_search($expr, $dayfrom, $dayto, $to-$from, $dxchan); + } + $expr =~ s/\$f(\d\d?)/\$ref->[$1]/g; # swap the letter n for the correct field name # $expr =~ s/\$f(\d)/\$spots[$1]/g; # swap the letter n for the correct field name @@ -298,7 +356,7 @@ 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]" ; + return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, ($_[3]||''), "<$_[4]" ; } # @@ -334,7 +392,8 @@ sub dup # remove SSID or area $by =~ s|[-/]\d+$||; - $freq = sprintf "%.1f", $freq; # normalise frequency +# $freq = sprintf "%.1f", $freq; # normalise frequency + $freq = int $freq; # normalise frequency $call = substr($call, 0, $maxcalllth) if length $call > $maxcalllth; chomp $text; @@ -346,15 +405,18 @@ sub dup $text = "" if $cty == $try[0]; } } - $text = substr($text, 0, $duplth) if length $text > $duplth; - $text =~ s/\s+$//; my $otext = $text; - $text = pack("C*", map {$_ & 127} unpack("C*", $text)); - $text =~ s/[^\w]//g; +# $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 $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; DXDupe::add($ldupkey, $main::systime+$dupage); + $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);