]> gb7djk.dxcluster.net Git - spider.git/blob - cmd/show/hftable.pl
25cb9c0ba9d4f786a381ae4ac30aca0bc5e5473d
[spider.git] / 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);