cmd/show/vhftable.pl

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