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