cmd/show/vhftable.pl

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