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