cmd/show/hftable.pl

   1  #
   2 # do an HFSpot table
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 #
   7 #
   8 # Modified on 2002/10/27 by K1XX for his own use
   9 # Valid inputs (and then tarted up by G1TLH to include in the
  10 # main distribution):
  11 #
  12 # sh/hftable (original operation, starts from today for own prefix)
  13 #
  14 # sh/hftable [<date>] [<no. of days>] [prefix] [prefix] [prefix] ..
  15 #
  16 # sh/hftable [<date>] [<no. of days>]  (data from your own prefix)
  17 #
  18 # sh/hftable [<date>] [<no. of days>] [callsign] [callsign] [callsign] ..
  19 #
  20 # sh/hftable [<date>] [<no of days>] all
  21 #
  22 #
  23 # Known good data formats
  24 # dd-mmm-yy
  25 # 24-Nov-02 (using - . or / as separator)
  26 # 24nov02 (ie no separators)
  27 # 24nov2002
  28 #
  29 # mm-dd-yy (this depends on your locale settings)
  30 # 11-24-02 (using - . or / as separator)
  31 #
  32 # yymmdd
  33 # 021124
  34 # 20021124
  35 #
  36
  37  my @calls;
  38  my $days = 31;
  39  my @dxcc;
  40  my $limit = 100;
  41  my $now;
  42  my @pref;
  43  my $date;
  44  my $all;
  45
  46  sub handle
  47  {
  48          my ($self, $line) = @_;
  49
  50          my @out;
  51
  52          my @f = split /\s+/, $line;
  53
  54          #$DB::single = 1;
  55
  56          while (@f) {
  57                  my $f = shift @f;
  58
  59                  if ($f =~ /^\d+$/ && $f < 366) { # no of days
  60                          $days = $f;
  61                          next;
  62                  }
  63                  if (my $utime = Date::Parse::str2time($f)) { # is it a parseable date?
  64                          $utime += 3600;
  65                          $now = Julian::Day->new($utime);
  66                          $date = cldate($utime);
  67                          next;
  68                  }
  69                  $f = uc $f;
  70                  if (is_callsign($f)) {
  71                          push @dxcc, [$f, 0];
  72                          push @pref, $f;
  73                  }
  74                  else {
  75                          if ($f eq 'ALL' ) {
  76                                  $all++;
  77                                  push @pref, $f;
  78                                  next;
  79                          }
  80                          if (my @ciz = Prefix::to_ciz('nc', $f)) {
  81                                  push @dxcc, map {[$_, 2]} @ciz;
  82                                  push @pref, $f;
  83                          }
  84                          else {
  85                                  push @out, $self->msg('e27', $f);
  86                          }
  87                  }
  88          }
  89
  90          # return error messages if any
  91          return (1, @out) if @out;
  92
  93          # default prefixes
  94          unless (@pref) {          # no prefix or callsign, use default prefix
  95                  push @dxcc, [$_, 2] for @main::my_cc;
  96                  push @pref, $main::mycall;
  97          }
  98
  99          # default date
 100          unless ($now) {
 101                  $now = Julian::Day->new(time); #no starting date
 102                  $date = cldate(time);
 103          }
 104
 105
 106          if ($self->{_nospawn}) {
 107                  @out = generate($self);
 108          } else {
 109                  @out = $self->spawn_cmd("show/hftable $line", sub { return (generate($self)); });
 110          }
 111
 112          return (1, @out);
 113  }
 114
 115 sub generate
 116  {
 117          my $self = shift;
 118
 119         my @out;
 120         my %list;
 121         my $i;
 122
 123         # generate the spot list
 124         for ($i = 0; $i < $days; $i++) {
 125                 my $fh = $Spot::statp->open($now); # get the next file
 126                 unless ($fh) {
 127                         Spot::genstats($now);
 128                         $fh = $Spot::statp->open($now);
 129                 }
 130                 while (<$fh>) {
 131                         chomp;
 132                         my @l = split /\^/;
 133                         next if $l[0] eq 'TOTALS';
 134                         next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc;
 135                         my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0];
 136                         my $j = 1;
 137                         foreach my $item (@l[4..13]) {
 138                                 $ref->[$j] += $item;
 139                                 $ref->[0] += $item;
 140                                 $j++;
 141                         }
 142                         $list{$l[0]} = $ref if $ref->[0];
 143                 }
 144                 $now = $now->sub(1);
 145         }
 146
 147         my @tot;
 148         my $nocalls;
 149
 150         my $l = join ',', @pref;
 151         push @out, $self->msg('stathft', $l, $date, $days);
 152         push @out, sprintf "%9s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Callsign Tot 160m 80m 60m 40m 30m 20m 17m 15m 12m 10m);
 153
 154         for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) {
 155                 my $ref = $list{$_};
 156                 $nocalls++;
 157                 my @list = (sprintf "%9s", $_);
 158                 foreach my $j (0..11) {
 159                         my $r = $ref->[$j];
 160                         if ($r) {
 161                                 $tot[$j] += $r;
 162                                 $r = sprintf("%5d", $r);
 163                         }
 164                         else {
 165                                 $r = '     ';
 166                         }
 167                         push @list, $r;
 168                 }
 169                 push @out, join('|', @list);
 170                 last if $limit && $nocalls >= $limit;
 171         }
 172
 173         $nocalls = sprintf "%9s", "$nocalls calls";
 174         @tot = map {$_ ?  sprintf("%5d", $_) : '     ' } @tot;
 175         push @out, join('|', $nocalls, @tot,"");
 176         return @out;
 177 }