]> scm.dxcluster.org Git - spider.git/blob - perl/Spot.pm
*** empty log message ***
[spider.git] / perl / Spot.pm
1 #
2 # the dx spot handler
3 #
4 # Copyright (c) - 1998 Dirk Koopman G1TLH
5 #
6 # $Id$
7 #
8
9 package Spot;
10
11 use IO::File;
12 use DXVars;
13 use DXDebug;
14 use DXUtil;
15 use DXLog;
16 use Julian;
17 use Prefix;
18 use DXDupe;
19
20 use strict;
21 use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef);
22
23 $fp = undef;
24 $maxspots = 50;                                 # maximum spots to return
25 $defaultspots = 10;                             # normal number of spots to return
26 $maxdays = 3*31;                                # normal maximum no of days to go back
27 $dirprefix = "spots";
28 $duplth = 20;                                   # the length of text to use in the deduping
29 $dupage = 3*3600;               # the length of time to hold spot dups
30 $filterdef = bless ([
31                           # tag, sort, field, priv, special parser 
32                           ['freq', 'r', 0, 0, \&decodefreq],
33                           ['on', 'r', 0, 0, \&decodefreq],
34                           ['call', 'c', 1],
35                           ['info', 't', 3],
36                           ['by', 'c', 4],
37                           ['call_dxcc', 'n', 5],
38                           ['by_dxcc', 'n', 6],
39                           ['origin', 'c', 7, 9],
40                           ['call_itu', 'n', 8],
41                           ['call_zone', 'n', 9],
42                           ['by_itu', 'n', 10],
43                           ['by_zone', 'n', 11],
44                           ['channel', 'n', 12, 9],
45                          ], 'Filter::Cmd');
46
47
48 # create a Spot Object
49 sub new
50 {
51         my $class = shift;
52         my $self = [ @_ ];
53         return bless $self, $class;
54 }
55
56 sub decodefreq
57 {
58         my $dxchan = shift;
59         my $l = shift;
60         my @f = split /,/, $l;
61         my @out;
62         my $f;
63         
64         foreach $f (@f) {
65                 my ($a, $b); 
66                 if (m{^\d+/\d+$}) {
67                         push @out, $f;
68                 } elsif (($a, $b) = $f =~ m{^(\w+)(?:/(\w+))?$}) {
69                         $b = lc $b if $b;
70                         my @fr = Bands::get_freq(lc $a, $b);
71                         if (@fr) {
72                                 while (@fr) {
73                                         $a = shift @fr;
74                                         $b = shift @fr;
75                                         push @out, "$a/$b";  # add them as ranges
76                                 }
77                         } else {
78                                 return ('dfreq', $dxchan->msg('dfreq1', $f));
79                         }
80                 } else {
81                         return ('dfreq', $dxchan->msg('e20', $f));
82                 }
83         }
84         return (0, join(',', @out));                     
85 }
86
87 sub init
88 {
89         mkdir "$dirprefix", 0777 if !-e "$dirprefix";
90         $fp = DXLog::new($dirprefix, "dat", 'd');
91 }
92
93 sub prefix
94 {
95         return $fp->{prefix};
96 }
97
98 # add a spot to the data file (call as Spot::add)
99 sub add
100 {
101         my @spot = @_;                          # $freq, $call, $t, $comment, $spotter = @_
102         my @out = @spot[0..4];      # just up to the spotter
103
104         # normalise frequency
105         $spot[0] = sprintf "%.f", $spot[0];
106   
107         # remove ssids if present on spotter
108         $out[4] =~ s/-\d+$//o;
109
110         # remove leading and trailing spaces
111         $spot[3] = unpad($spot[3]);
112         
113         # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call
114         my @dxcc = Prefix::extract($out[1]);
115         my $spotted_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
116         my $spotted_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0;
117         my $spotted_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0;
118         push @out, $spotted_dxcc;
119         @dxcc = Prefix::extract($out[4]);
120         my $spotter_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
121         my $spotter_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0;
122         my $spotter_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0;
123         push @out, $spotter_dxcc;
124         push @out, $spot[5];
125
126         my $buf = join("\^", @out);
127
128         # compare dates to see whether need to open another save file (remember, redefining $fp 
129         # automagically closes the output file (if any)). 
130         $fp->writeunix($out[2], $buf);
131   
132         return (@out, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq);
133 }
134
135 # search the spot database for records based on the field no and an expression
136 # this returns a set of references to the spots
137 #
138 # the expression is a legal perl 'if' statement with the possible fields indicated
139 # by $f<n> where :-
140 #
141 #   $f0 = frequency
142 #   $f1 = call
143 #   $f2 = date in unix format
144 #   $f3 = comment
145 #   $f4 = spotter
146 #   $f5 = spotted dxcc country
147 #   $f6 = spotter dxcc country
148 #   $f7 = origin
149 #
150 #
151 # In addition you can specify a range of days, this means that it will start searching
152 # from <n> days less than today to <m> days less than today
153 #
154 # Also you can select a range of entries so normally you would get the 0th (latest) entry
155 # back to the 5th latest, you can specify a range from the <x>th to the <y>the oldest.
156 #
157 # This routine is designed to be called as Spot::search(..)
158 #
159
160 sub search
161 {
162         my ($expr, $dayfrom, $dayto, $from, $to, $hint) = @_;
163         my $eval;
164         my @out;
165         my $ref;
166         my $i;
167         my $count;
168         my @today = Julian::unixtoj(time());
169         my @fromdate;
170         my @todate;
171
172         $dayfrom = 0 if !$dayfrom;
173         $dayto = $maxdays if !$dayto;
174         @fromdate = Julian::sub(@today, $dayfrom);
175         @todate = Julian::sub(@fromdate, $dayto);
176         $from = 0 unless $from;
177         $to = $defaultspots unless $to;
178         $hint = $hint ? "next unless $hint" : "";
179         $expr = "1" unless $expr;
180         
181         $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
182
183         $expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
184         #  $expr =~ s/\$f(\d)/\$spots[$1]/g;               # swap the letter n for the correct field name
185   
186         dbg("search", "hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
187   
188         # build up eval to execute
189         $eval = qq(
190                            while (<\$fh>) {
191                                    $hint;
192                                    chomp;
193                                    push \@spots, [ split '\\^' ];
194                            }
195                            my \$c;
196                            my \$ref;
197                            for (\$c = \$#spots; \$c >= 0; \$c--) {
198                                         \$ref = \$spots[\$c];
199                                         if ($expr) {
200                                                 \$count++;
201                                                 next if \$count < \$from; # wait until from 
202                                                 push(\@out, \$ref);
203                                                 last if \$count >= \$to; # stop after to
204                                         }
205                                 }
206                           );
207
208         $fp->close;                                     # close any open files
209
210         for ($i = $count = 0; $i < $maxdays; ++$i) {    # look thru $maxdays worth of files only
211                 my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
212                 last if Julian::cmp(@now, @todate) <= 0;         
213         
214                 my @spots = ();
215                 my $fh = $fp->open(@now); # get the next file
216                 if ($fh) {
217                         my $in;
218                         eval $eval;                     # do the search on this file
219                         last if $count >= $to; # stop after to
220                         return ("Spot search error", $@) if $@;
221                 }
222         }
223
224         return @out;
225 }
226
227 # change a freq range->regular expression
228 sub ftor
229 {
230         my ($a, $b) = @_;
231         return undef unless $a < $b;
232         $b--;
233         my $d = $b - $a;
234         my @a = split //, $a;
235         my @b = split //, $b;
236         my $out;
237         while (@b > @a) {
238                 $out .= shift @b;
239         }
240         while (@b) {
241                 my $aa = shift @a;
242                 my $bb = shift @b;
243                 if (@b < (length $d) - 1) {
244                         $out .= '\\d';
245                 } elsif ($aa eq $bb) {
246                         $out .= $aa;
247                 } elsif ($aa < $bb) {
248                         $out .= "[$aa-$bb]";
249                 } else {
250                         $out .= "[0-$bb$aa-9]";
251                 }
252         }
253         return $out;
254 }
255
256 # format a spot for user output in 'broadcast' mode
257 sub formatb
258 {
259         my $wantgrid = shift;
260         my $t = ztime($_[2]);
261         my $ref = DXUser->get_current($_[4]);
262         my $loc = $ref->qra if $ref && $ref->qra && $wantgrid;
263         $loc = ' ' . substr($ref->qra, 0, 4) if $loc;
264         $loc = "" unless $loc;
265         return sprintf "DX de %-7.7s%11.1f  %-12.12s %-30s %s$loc", "$_[4]:", $_[0], $_[1], $_[3], $t ;
266 }
267
268 # format a spot for user output in list mode
269 sub formatl
270 {
271         my $t = ztime($_[2]);
272         my $d = cldate($_[2]);
273         return sprintf "%8.1f  %-11s %s %s  %-28.28s%7s>", $_[0], $_[1], $d, $t, $_[3], "<$_[4]" ;
274 }
275
276 #
277 # return all the spots from a day's file as an array of references
278 # the parameter passed is a julian day
279 sub readfile
280 {
281         my @spots;
282         
283         my $fh = $fp->open(@_); 
284         if ($fh) {
285                 my $in;
286                 while (<$fh>) {
287                         chomp;
288                         push @spots, [ split '\^' ];
289                 }
290         }
291         return @spots;
292 }
293
294 # enter the spot for dup checking and return true if it is already a dup
295 sub dup
296 {
297         my ($freq, $call, $d, $text) = @_; 
298
299         # dump if too old
300         return 2 if $d < $main::systime - $dupage;
301  
302         $freq = sprintf "%.1f", $freq;       # normalise frequency
303         chomp $text;
304         $text = substr($text, 0, $duplth) if length $text > $duplth; 
305         unpad($text);
306         $text =~ s/[\\\%]\d+//g;
307         $text =~ s/[^a-zA-Z0-9]//g;
308         my $dupkey = "X$freq|$call|$d|\L$text";
309         return DXDupe::check($dupkey, $main::systime+$dupage);
310 }
311
312 sub listdups
313 {
314         return DXDupe::listdups('X', $dupage, @_);
315 }
316 1;
317
318
319
320