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