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