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 $maxdays = 60;    # maximum no of days to store spots in the table
  22 my $prefix = "$main::data/spots";
  23 my @table = ();      # the list of spots (held in reverse order)
  24
  25 # read in n days worth of dx spots into memory
  26 sub init
  27 {
  28   my @today = julian->unixtoj(time);        # get the julian date now
  29   my @first = julian->sub(@today, $maxdays);     # get the date $maxdays ago
  30   my $count;
  31
  32   mkdir($prefix, 0777) if ! -e $prefix;     # create the base directory if required
  33   for (my $i = 0; $i < $maxdays; ++$i) {
  34     my $ref = spot->open(@first);
  35         if ($ref) {
  36           my $fh = $ref->{fh};
  37           my @out = ();
  38           while (<$fh>) {
  39             chomp;
  40             my @ent = split /\^/;
  41
  42         push @spot::table, \@ent;                # stick this ref to anon list on the FRONT of the table
  43
  44             ++$count;
  45           }
  46         }
  47     @first = julian->add(@first, 1);
  48   }
  49   return $count;
  50 }
  51
  52 # create a new spot on the front of the list, add it to the data file
  53 sub new
  54 {
  55   my $pkg = shift;
  56   my @spot = @_;    # $freq, $call, $t, $comment, $spotter = @_
  57
  58   # sure that the numeric things are numeric now (saves time later)
  59   $spot[0] = 0 + $spot[0];
  60   $spot[2] = 0 + $spot[2];
  61
  62   # save it on the front of the list
  63   unshift @spot::table,  \@spot;
  64
  65   # compare dates to see whether need to open a other save file
  66   my @date = julian->unixtoj($spot[2]);
  67   $fp = spot->open(@date, ">>") if (!$fp || julian->cmp(@date, $fp->{year}, $fp->{day}));
  68   my $fh = $fp->{fh};
  69   $fh->print(join("\^", @spot), "\n");
  70 }
  71
  72 # purge all the spots older than $maxdays - this is fairly approximate
  73 # this should be done periodically from some cron task
  74 sub purge
  75 {
  76   my $old = time - ($maxdays * 86400);
  77   my $ref;
  78
  79   while (@spot::table) {
  80     my $ref = pop @spot::table;
  81         if (${$ref}[2] > $old) {
  82           push @spot::table, $ref;        # put it back
  83           last;                     # and leave
  84         }
  85   }
  86 }
  87
  88 # search the spot database for records based on the field no and an expression
  89 # this returns a set of references to the spots
  90 #
  91 # for string fields supply a pattern to match
  92 # for numeric fields supply a range of the format 'n > x  && n < y' (the n will
  93 # changed to the correct field name) [ n is literally the letter 'n' ]
  94 #
  95 sub search
  96 {
  97   my ($pkg, $field, $expr, $from, $to) = @_;
  98   my $eval;
  99   my @out;
 100   my $ref;
 101   my $i;
 102
 103   dbg('spot', "input expr = $expr\n");
 104   if ($field == 0 || $field == 2) {              # numeric fields
 105     $expr =~ s/n/\$ref->[$field]/g;               # swap the letter n for the correct field name
 106   } else {
 107     $expr = qq(\$ref->[$field] =~ /$expr/oi);      # alpha expressions
 108   }
 109   dbg('spot', "expr now = $expr\n");
 110
 111   # build up eval to execute
 112   $eval = qq(foreach \$ref (\@spot::table) {
 113     next if \$i < \$from;
 114         if ($expr) {
 115        unshift(\@out, \$ref);
 116            \$i++;
 117            last if \$to && \$i >= \$to;
 118         }
 119   });
 120   dbg('spot', "eval = $eval\n");
 121   eval $eval;                                   # execute it
 122   return @out;
 123 }
 124
 125 # open a spot file of the julian day
 126 sub open
 127 {
 128   my $pkg = shift;
 129   return julian->open("spot", $prefix, @_);
 130 }
 131
 132 # close a spot file
 133 sub close
 134 {
 135   # do nothing, unreferencing or overwriting the $self will close it
 136 }
 137
 138 1;