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 ($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         push @dxcc, [$_, 2] for @main::my_cc;
  91         push @pref, $main::mycall;
  92 }
  93
  94 # default date
  95 unless ($now) {
  96         $now = Julian::Day->new(time); #no starting date
  97         $date = cldate(time);
  98 }
  99
 100 # generate the spot list
 101 for ($i = 0; $i < $days; $i++) {
 102         my $fh = $Spot::statp->open($now); # get the next file
 103         unless ($fh) {
 104                 Spot::genstats($now);
 105                 $fh = $Spot::statp->open($now);
 106         }
 107         while (<$fh>) {
 108                 chomp;
 109                 my @l = split /\^/;
 110                 next if $l[0] eq 'TOTALS';
 111                 next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc;
 112                 my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0];
 113                 my $j = 1;
 114                 foreach my $item (@l[4..13]) {
 115                         $ref->[$j] += $item;
 116                         $ref->[0] += $item;
 117                         $j++;
 118                 }
 119                 $list{$l[0]} = $ref if $ref->[0];
 120         }
 121         $now = $now->sub(1);
 122 }
 123
 124 my @tot;
 125 my $nocalls;
 126
 127 my $l = join ',', @pref;
 128 push @out, $self->msg('stathft', $l, $date, $days);
 129 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);
 130
 131 for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) {
 132         my $ref = $list{$_};
 133         $nocalls++;
 134         my @list = (sprintf "%9s", $_);
 135         foreach my $j (0..11) {
 136                 my $r = $ref->[$j];
 137                 if ($r) {
 138                         $tot[$j] += $r;
 139                         $r = sprintf("%5d", $r);
 140                 } else {
 141                         $r = '     ';
 142                 }
 143                 push @list, $r;
 144         }
 145         push @out, join('|', @list);
 146         last if $limit && $nocalls >= $limit;
 147 }
 148
 149 $nocalls = sprintf "%9s", "$nocalls calls";
 150 @tot = map {$_ ?  sprintf("%5d", $_) : '     ' } @tot;
 151 push @out, join('|', $nocalls, @tot,"");
 152
 153 return (1, @out);