X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=0761f07d0522f865ad10d4c950df4d12033f7f02;hb=refs%2Fheads%2Fnewusers;hp=a87b9c85b1b6c8581f2ad4675675b2654ea584bc;hpb=495e620d66fbc1b8c64dd65ff8d89fc43a2e6f08;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index a87b9c85..0761f07d 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -3,7 +3,7 @@ # # Copyright (c) - 1998 Dirk Koopman G1TLH # -# $Id$ +# # package Spot; @@ -21,7 +21,8 @@ use QSL; use strict; -use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots $maxcalllth $can_encode); +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; @@ -33,25 +34,35 @@ $duplth = 20; # the length of text to use in the deduping $dupage = 1*3600; # the length of time to hold spot dups $maxcalllth = 12; # the max length of call to take into account for dupes $filterdef = bless ([ - # tag, sort, field, priv, special parser - ['freq', 'r', 0, 0, \&decodefreq], - ['on', 'r', 0, 0, \&decodefreq], - ['call', 'c', 1], - ['info', 't', 3], - ['by', 'c', 4], - ['call_dxcc', 'nc', 5], - ['by_dxcc', 'nc', 6], - ['origin', 'c', 7, 9], - ['call_itu', 'ni', 8], - ['call_zone', 'nz', 9], - ['by_itu', 'ni', 10], - ['by_zone', 'nz', 11], - ['call_state', 'ns', 12], - ['by_state', 'ns', 13], - ['channel', 'c', 14], - - ], 'Filter::Cmd'); + # tag, sort, field, priv, special parser + ['freq', 'r', 0, 0, \&decodefreq], + ['on', 'r', 0, 0, \&decodefreq], + ['call', 'c', 1], + ['info', 't', 3], + ['by', 'c', 4], + ['call_dxcc', 'nc', 5], + ['by_dxcc', 'nc', 6], + ['origin', 'c', 7, 9], + ['call_itu', 'ni', 8], + ['call_zone', 'nz', 9], + ['by_itu', 'ni', 10], + ['by_zone', 'nz', 11], + ['call_state', 'ns', 12], + ['by_state', 'ns', 13], + ['ip', 'c', 14], +# ['channel', 'c', 15], +# ['rbn', 'a', 4, 0, \&filterrbnspot], + ], 'Filter::Cmd'); $totalspots = $hfspots = $vhfspots = 0; +$use_db_for_search = 0; + +our $usetac = 0; +our $readback; + +if ($usetac) { + $readback = `which tac`; + chomp $readback; +} # create a Spot Object sub new @@ -92,6 +103,13 @@ sub decodefreq return (0, join(',', @out)); } +# filter setup for rbn spot so return the regex to detect it +sub filterrbnspot +{ + my $dxchan = shift; + return ('-#$'); +} + sub init { mkdir "$dirprefix", 0777 if !-e "$dirprefix"; @@ -109,45 +127,46 @@ sub init 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) { +# $main::dbh->{RaiseError} = 0; + $main::dbh->begin_work; my $count = 0; while (<$fh>) { chomp; my @s = split /\^/; - if (@s < 12) { + if (@s < 14) { 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, $a[2], $b[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; + $main::dbh->commit; dbg("inserted $count spots from $now->[0] $now->[1]"); $fh->close; $total += $count; } $now = $now->add(1); } + $main::dbh->begin_work; $main::dbh->spot_add_indexes; $main::dbh->commit; - $main::dbh->{RaiseError} = 1; +# $main::dbh->{RaiseError} = 1; $t = time - $t; my $min = int($t / 60); my $sec = $t % 60; dbg("$total spots converted in $min:$sec"); } + unless ($main::dbh->has_ipaddr) { + $main::dbh->add_ipaddr; + dbg("added ipaddr field to spot table"); + } } } @@ -159,7 +178,7 @@ 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 @@ -178,7 +197,12 @@ 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]); + + # thus we now have: + # freq, call, time, comment, spotter, call country code, call itu, call cqzone, spotter country code, spotter itu, spotter cqzone, call state, spotter state, node, spotter ip address + return @out; } sub add @@ -186,6 +210,7 @@ sub add my $buf = join('^', @_); $fp->writeunix($_[2], $buf); if ($main::dbh) { + $main::dbh->begin_work; $main::dbh->spot_insert(\@_); $main::dbh->commit; } @@ -197,7 +222,7 @@ sub add } if ($_[3] =~ /(?:QSL|VIA)/i) { my $q = QSL::get($_[1]) || new QSL $_[1]; - $q->update($_[3], $_[2], $_[4]); + $q->update($_[3], $_[2], $_[4]) if $q; } } @@ -215,7 +240,7 @@ sub add # $f5 = spotted dxcc country # $f6 = spotter dxcc country # $f7 = origin -# +# $f8 = ip address # # In addition you can specify a range of days, this means that it will start searching # from days less than today to days less than today @@ -250,7 +275,7 @@ sub search $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0; - if ($main::dbh) { + if ($main::dbh && $use_db_for_search) { return $main::dbh->spot_search($expr, $dayfrom, $dayto, $to-$from, $dxchan); } @@ -282,31 +307,50 @@ sub search my \@s = split /\\^/; $checkfilter; push \@spots, \\\@s; + shift \@spots if \@spots > $to + 2; } my \$c; my \$ref; - for (\$c = \$#spots; \$c >= 0; \$c--) { - \$ref = \$spots[\$c]; - if ($expr) { - \$count++; - next if \$count < \$from; # wait until from - push(\@out, \$ref); - last if \$count >= \$to; # stop after to - } - } + if (\$readback) { + foreach \$ref (\@spots) { + if ($expr) { + \$count++; + next if \$count < $from; # wait until from + push(\@out, \$ref); + last if \$count >= $to; # stop after to + } + } + } else { + for (\$c = \$#spots; \$c >= 0; \$c--) { + \$ref = \$spots[\$c]; + if ($expr) { + \$count++; + next if \$count < $from; # wait until from + push(\@out, \$ref); + last if \$count >= $to; # stop after to + } + } + } ); + + dbg("Spot eval: $eval") if isdbg('searcheval'); - - $fp->close; # close any open files - + my $fh; + my $now = $fromdate; for ($i = $count = 0; $i < $maxdays; ++$i) { # look thru $maxdays worth of files only - my $now = $fromdate->sub($i); # but you can pick which $maxdays worth - last if $now->cmp($todate) <= 0; - - my @spots = (); - my $fh = $fp->open($now); # get the next file + my @spots; + last if $now->cmp($todate) <= 0; + + if ($readback) { + my $fn = $fp->fn($now->sub($i)); + dbg("search using tac fn: $fn $i") if isdbg('search'); + $fh = IO::File->new("$readback $fn |"); + } else { + $fh = $fp->open($now->sub($i)); # get the next file + dbg("search fn: $fp->{fn} $i") if isdbg('search'); + } if ($fh) { my $in; eval $eval; # do the search on this file @@ -396,17 +440,16 @@ sub dup $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+$/) { + 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 = Encode::encode("iso-8859-1", $text) if $main::can_encode && Encode::is_utf8($text, 1); $text =~ s/^\+\w+\s*//; # remove leading LoTW callsign - $text = pack("C*", map {$_ & 127} unpack("C*", $text)); $text =~ s/\s{2,}[\dA-Z]?[A-Z]\d?$// if length $text > 24; - $text =~ s/[^\w]//g; + $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);