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