cmd/show/hftable.pl

   1 #
   2 # do an HFSpot table
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   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 ($self, $line) = @_;
  38 my @f = split /\s+/, $line;
  39 my @calls;
  40 my $days = 31;
  41 my @dxcc;
  42 my $limit = 100;
  43 my %list;
  44 my $i;
  45 my $now;
  46 my @pref;
  47 my @out;
  48 my $date;
  49 my $all;
  50
  51 #$DB::single = 1;
  52
  53 while (@f) {
  54         my $f = shift @f;
  55
  56         if ($f =~ /^\d+$/ && $f < 366) {                # no of days
  57                 $days = $f;
  58                 next;
  59         }
  60         if (my $utime = Date::Parse::str2time($f)) {    # is it a parseable date?
  61                 $utime += 3600;
  62                 $now = Julian::Day->new($utime);
  63                 $date = cldate($utime);
  64                 next;
  65         }
  66         $f = uc $f;
  67         if (is_callsign($f)) {
  68                 push @dxcc, [$f, 0];
  69                 push @pref, $f;
  70         } else {
  71                 if ($f eq 'ALL' ) {
  72                         $all++;
  73                         push @pref, $f;
  74                         next;
  75                 }
  76                 if (my @ciz = Prefix::to_ciz('nc', $f)) {
  77                         push @dxcc, map {[$_, 2]} @ciz;
  78                         push @pref, $f;
  79                 } else {
  80                         push @out, $self->msg('e27', $f);
  81                 }
  82         }
  83 }
  84
  85 # return error messages if any
  86 return (1, @out) if @out;
  87
  88 # default prefixes
  89 unless (@pref) {                                        # no prefix or callsign, use default prefix
  90         if ($self->dxcc >= 61 && $self->dxcc < 67) {
  91                 push @dxcc, [$_, 2] for (61..67);
  92                 push @pref, "GB";
  93         } else {
  94                 push @dxcc, [$self->dxcc, 2];
  95                 push @pref, $self->call;
  96         }
  97 }
  98
  99 # default date
 100 unless ($now) {
 101         $now = Julian::Day->new(time); #no starting date
 102         $date = cldate(time);
 103 }
 104
 105 # generate the spot list
 106 for ($i = 0; $i < $days; $i++) {
 107         my $fh = $Spot::statp->open($now); # get the next file
 108         unless ($fh) {
 109                 Spot::genstats($now);
 110                 $fh = $Spot::statp->open($now);
 111         }
 112         while (<$fh>) {
 113                 chomp;
 114                 my @l = split /\^/;
 115                 next if $l[0] eq 'TOTALS';
 116                 next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc;
 117                 my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0];
 118                 my $j = 1;
 119                 foreach my $item (@l[4..13]) {
 120                         $ref->[$j] += $item;
 121                         $ref->[0] += $item;
 122                         $j++;
 123                 }
 124                 $list{$l[0]} = $ref if $ref->[0];
 125         }
 126         $now = $now->sub(1);
 127 }
 128
 129 my @tot;
 130 my $nocalls;
 131
 132 my $l = join ',', @pref;
 133 push @out, $self->msg('stathft', $l, $date, $days);
 134 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);
 135
 136 for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) {
 137         my $ref = $list{$_};
 138         $nocalls++;
 139         my @list = (sprintf "%9s", $_);
 140         foreach my $j (0..11) {
 141                 my $r = $ref->[$j];
 142                 if ($r) {
 143                         $tot[$j] += $r;
 144                         $r = sprintf("%5d", $r);
 145                 } else {
 146                         $r = '     ';
 147                 }
 148                 push @list, $r;
 149         }
 150         push @out, join('|', @list);
 151         last if $limit && $nocalls >= $limit;
 152 }
 153
 154 $nocalls = sprintf "%9s", "$nocalls calls";
 155 @tot = map {$_ ?  sprintf("%5d", $_) : '     ' } @tot;
 156 push @out, join('|', $nocalls, @tot,"");
 157
 158 return (1, @out);