did some work on the cluster database related things
[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 Julian;
15 use Prefix;
16 use Carp;
17
18 @ISA = qw(Julian);
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 = "$main::data/spots";
28
29 sub prefix
30 {
31   return $dirprefix;
32 }
33
34 # add a spot to the data file (call as Spot::add)
35 sub add
36 {
37   my @spot = @_;    # $freq, $call, $t, $comment, $spotter = @_
38
39   # sure that the numeric things are numeric now (saves time later)
40   $spot[0] = 0 + $spot[0];
41   $spot[2] = 0 + $spot[2];
42   
43   # remove ssid if present on spotter
44   $spot[4] =~ s/-\d+$//o;
45
46   # compare dates to see whether need to open another save file (remember, redefining $fp 
47   # automagically closes the output file (if any))
48   my @date = Julian::unixtoj($spot[2]);
49   $fp = Spot->open(@date, ">>") if (!$fp || Julian::cmp(@date, $fp->{year}, $fp->{day}));
50
51   # save it
52   my $fh = $fp->{fh};
53
54   # add the 'dxcc' country on the end
55   my @dxcc = Prefix::extract($spot[1]);
56   push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
57
58   $fh->print(join("\^", @spot), "\n");
59 }
60
61 # search the spot database for records based on the field no and an expression
62 # this returns a set of references to the spots
63 #
64 # the expression is a legal perl 'if' statement with the possible fields indicated
65 # by $f<n> where :-
66 #
67 #   $f0 = frequency
68 #   $f1 = call
69 #   $f2 = date in unix format
70 #   $f3 = comment
71 #   $f4 = spotter
72 #   $f5 = dxcc country
73 #
74 # In addition you can specify a range of days, this means that it will start searching
75 # from <n> days less than today to <m> days less than today
76 #
77 # Also you can select a range of entries so normally you would get the 0th (latest) entry
78 # back to the 5th latest, you can specify a range from the <x>th to the <y>the oldest.
79 #
80 # This routine is designed to be called as Spot::search(..)
81 #
82
83 sub search
84 {
85   my ($expr, $dayfrom, $dayto, $from, $to) = @_;
86   my $eval;
87   my @out;
88   my $ref;
89   my $i;
90   my $count;
91   my @today = Julian::unixtoj(time);
92   my @fromdate;
93   my @todate;
94   
95   if ($dayfrom > 0) {
96     @fromdate = Julian::sub(@today, $dayfrom);
97   } else {
98     @fromdate = @today;
99         $dayfrom = 0;
100   }
101   if ($dayto > 0) {
102     @todate = Julian::sub(@fromdate, $dayto);
103   } else {
104     @todate = Julian::sub(@fromdate, $maxdays);
105   }
106   if ($from || $to) {
107     $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
108   } else {
109     $from = 0;
110         $to = $defaultspots;
111   }
112
113   $expr =~ s/\$f(\d)/\$ref->[$1]/g;               # swap the letter n for the correct field name
114   
115   dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
116   
117   # build up eval to execute
118   $eval = qq(my \$c;
119     for (\$c = \$#spots; \$c >= 0; \$c--) {
120           \$ref = \$spots[\$c];
121           if ($expr) {
122             \$count++;
123                 next if \$count < \$from;                  # wait until from 
124         push(\@out, \$ref);
125                 last LOOP if \$count >= \$to;                  # stop after to
126           }
127   });
128
129 LOOP:
130   for ($i = 0; $i < 60; ++$i) {
131     my @now = Julian::sub(@fromdate, $i);
132         last if Julian::cmp(@now, @todate) <= 0;         
133         
134         my @spots = ();
135         my $fp = Spot->open(@now);  # get the next file
136         if ($fp) {
137           my $fh = $fp->{fh};
138           my $in;
139           foreach $in (<$fh>) {
140             chomp $in;
141         push @spots, [ split('\^', $in) ];
142           }
143           my $ref;
144           eval $eval;               # do the search on this file
145           return ("error", $@) if $@;
146         }
147   }
148
149   return @out;
150 }
151
152 # open a spot file of the Julian day
153 sub open
154 {
155   my $pkg = shift;
156   return Julian::open("spot", $dirprefix, @_);
157 }
158
159 # close a spot file
160 sub close
161 {
162   # do nothing, unreferencing or overwriting the $self will close it  
163 }
164
165 1;