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