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