cmd/show/vhftable.pl

   1 #
   2 # do an VHFSpot table
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 my ($self, $line) = @_;
  10 my @f = split /\s+/, $line;
  11 my @calls;
  12 my $days = 31;
  13 my @dxcc;
  14 my $limit = 100;
  15 my %list;
  16 my $i;
  17 my $now;
  18 my @pref;
  19 my @out;
  20 my $date;
  21 my $all;
  22
  23 #$DB::single = 1;
  24
  25 while (@f) {
  26         my $f = shift @f;
  27
  28         if ($f =~ /^\d+$/ && $f < 366) {                # no of days
  29                 $days = $f;
  30                 next;
  31         }
  32         if (my $utime = Date::Parse::str2time($f)) {    # is it a parseable date?
  33                 $utime += 3600;
  34                 $now = Julian::Day->new($utime);
  35                 $date = cldate($utime);
  36                 next;
  37         }
  38         $f = uc $f;
  39         if (is_callsign($f)) {
  40                 push @dxcc, [$f, 0];
  41                 push @pref, $f;
  42         } else {
  43                 if ($f eq 'ALL' ) {
  44                         $all++;
  45                         push @pref, $f;
  46                         next;
  47                 }
  48                 if (my @ciz = Prefix::to_ciz('nc', $f)) {
  49                         push @dxcc, map {[$_, 2]} @ciz;
  50                         push @pref, $f;
  51                 } else {
  52                         push @out, $self->msg('e27', $f);
  53                 }
  54         }
  55 }
  56
  57 # return error messages if any
  58 return (1, @out) if @out;
  59
  60 # default prefixes
  61 unless (@pref) {                                        # no prefix or callsign, use default prefix
  62         if ($self->dxcc >= 61 && $self->dxcc < 67) {
  63                 push @dxcc, [$_, 2] for (61..67);
  64                 push @pref, "GB";
  65         } else {
  66                 push @dxcc, [$self->dxcc, 2];
  67                 push @pref, $self->call;
  68         }
  69 }
  70
  71 # default date
  72 unless ($now) {
  73         $now = Julian::Day->new(time); #no starting date
  74         $date = cldate(time);
  75 }
  76
  77 # generate the spot list
  78 for ($i = 0; $i < $days; $i++) {
  79         my $fh = $Spot::statp->open($now); # get the next file
  80         unless ($fh) {
  81                 Spot::genstats($now);
  82                 $fh = $Spot::statp->open($now);
  83         }
  84         while (<$fh>) {
  85                 chomp;
  86                 my @l = split /\^/;
  87                 next if $l[0] eq 'TOTALS';
  88                 next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc;
  89                 my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0];
  90                 my $j = 1;
  91                 foreach my $item (@l[14..16, 18..23]) {
  92                         $ref->[$j] += $item;
  93                         $ref->[0] += $item;
  94                         $j++;
  95                 }
  96                 $list{$l[0]} = $ref if $ref->[0];
  97         }
  98         $now = $now->sub(1);
  99 }
 100
 101 my @tot;
 102 my $nocalls;
 103
 104 my $l = join ',', @pref;
 105 push @out, $self->msg('statvhft', $l, $date, $days);
 106 #push @out, $self->msg('statvhft', join(',', @dxcc), cldate(time));
 107 push @out, sprintf "%10s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|", qw(Callsign Tot 6m 4m 2m 70cm 23cm 13cm 9cm 6cm 3cm);
 108
 109 for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) {
 110         my $ref = $list{$_};
 111         $nocalls++;
 112         my @list = (sprintf "%10s", $_);
 113         foreach my $j (0..9) {
 114                 my $r = $ref->[$j];
 115                 if ($r) {
 116                         $tot[$j] += $r;
 117                         $r = sprintf("%4d", $r);
 118                 } else {
 119                         $r = '    ';
 120                 }
 121                 push @list, $r;
 122         }
 123         push @out, join('|', @list, "");
 124         last if $limit && $nocalls >= $limit;
 125 }
 126
 127 $nocalls = sprintf "%10s", "$nocalls calls";
 128 @tot = map {$_ ?  sprintf("%4d", $_) : '    ' } @tot;
 129 push @out, join('|', $nocalls, @tot, "");
 130
 131 return (1, @out);