#!/usr/pkg/bin/perl # $Id: cabrillo2-time-table,v 1.108 2013/12/02 11:40:20 makoto Exp $ use strict; ### Can't use string ("2011-11-26;21") as a HASH ref while "strict refs" in use at /home/makoto/perl/ham-radio/cabrillo2-time-table line 526, <> line 826. use Getopt::Std; my(%opts); my($eachday); # 0 -> normal, 1 -> day by day mode better than $opts{'2'} ? # my $TZ = 900; # offet from GMT, not used for now # global variables written by read_cabrillo my %MATRIX; # read_cabrillo sets the value $MATRIX{$hour}{$exch} our %DAYS; # read_cabrillo picks the contest date (-2 option only) our %HOURS; my @myhours; # array of 0 .. 23 digits. my @myHOURS; # string of array of 0 .. 23 # per band QSO hash, read_cabrillo() will fill these hashes our (%MATRIX18, %MATRIX35, %MATRIX70, %MATRIX14, %MATRIX21, %MATRIX28); our %BANDS; our %CONTINENTS; our %MULTIS; our %CALLSIGN; # call sign database to check dupes our @DUPE; our %HOUR_SUM = (); #index will be the same as @HOURS %HOUR_SUM # (%HOUR_TOTAL is for each band for now) %BAND_HOUR_SUM our %ACUM; # save accumulated count by hour. # global variable for cty.dat reading our %CALLSIGN_TO_E; # store full callsign to entity database our %PREF_TO_CONTINENT; # store full callsign to continent database our %PREFIX4; # store four letter prefix (say, VK9X) our %PREFIX3; # store three letter prefix our %PREFIX2; # store two letter prefix our %PREFIX1; # store two letter prefix our $CTY_DAT = 'wl_cty.dat'; our $CTY_DAT_LOC = $ENV{HOME}.'/ham-radio/cty/'. $CTY_DAT; our %HISTGRAM; # Hash to memorize 'multi -> stations' datebase sub usage (){ # show help print < Date::Manip and DateTime::Format::DateManip Currently -c is required to run correctly. -a -2 doesn't work now. #' -a ARRL DX contest special, show by-MULTIS detail -c show Continent summary too, -z also helps. -d show warning for DUPE found -D cabrillo output made from DX category, no contest -e with -2 mode, specify the hour to end (see also -s) -g show no gap (sparse output for time direction) -h show this help -j By - Japan Call area, conflict with -a (choose -a or -j or -K or -T or none) -K KCJ Contest conflict with -a, -j, -T -m show rare station for multi less or equal to threshold. -s with -2 mode, specify the hour to start (see also -e) -t Normally, time is in GMT in cabrillo input file. If it is already converted to JST, use -t JST etc. -v print vertically (default -> horizontally, not implemented yet) -w output wide format (currently default, option not implemented yet) -z exchange in cabrillo file has zone, and utilize it. -X honor contest name in cabrillo format (not implemented yet) -T Tokyo Contest (not implemented yet) The Header shows hours in your local time. To get in UTC, use env TZ=utc [perl] $0 [-h] [-t JST] < cabrillo_file For $CTY_DAT file, read $ENV{HOME}/ham-radio/cty/$CTY_DAT; as a default. Download http://www.country-files.com/cty/wl_cty.dat for update. HELP } #' ## -u The output time table in UTC # ------------------------------------------ sub print_head($\@); sub dateFormat ($$$){ # convert (2009-10-12, gmt, time_zone) type string to Manip format 20091012T12:34:00 my $date_string = shift; my $gmt = shift; my $Tzone = shift; my $hh = substr($gmt,0,2); my $mm = substr($gmt,2,2); if ($opts{'2'}) { $Tzone = 'UTC'; # for by-date-format } my $dm; if (0) { $dm = ParseDate("$date_string $hh:$mm $Tzone"); } else { my $str = $date_string; $str =~ s/-//g; $dm = $str.$hh.':'.$mm; } print $dm,"\n"; return $dm; } sub get_band($){ # translate freq to (generic) band my $freq = shift; my $band; if ($freq == 50 ) { $band = 50;} elsif ($freq < 146 ) { $band = 144;} elsif ($freq < 440 ) { $band = 430;} elsif ($freq < 1300 ) { $band = 1200;} elsif ($freq < 1911 ) { $band = 1.8;} elsif ($freq < 2400 ) { $band = 1.9;} elsif ($freq < 2500 ) { $band = 2400;} elsif ($freq < 4000 ) { $band = 3.5;} elsif ($freq < 8000 ) { $band = 7;} elsif ($freq < 11000 ) { $band = 10;} elsif ($freq < 15000 ) { $band = 14;} elsif ($freq < 22000 ) { $band = 21;} elsif ($freq < 30000 ) { $band = 28;} elsif ($freq < 54000 ) { $band = 50;} elsif ($freq <146000 ) { $band = 144;} elsif ($freq <440000 ) { $band = 430;} else { $band = 0;} return $band; } sub set_ja_area() { # (for show_multi_matrix) Multiplier to call area my %AREA = qw ( 10 1 11 1 12 1 13 1 14 1 15 1 16 1 17 1 18 2 19 2 20 2 21 2 22 3 23 3 24 3 25 3 26 3 27 3 31 4 32 4 33 4 34 4 35 4 36 5 37 5 38 5 39 5 40 6 41 6 42 6 43 6 44 6 45 6 46 6 47 6 02 7 03 7 04 7 05 7 06 7 07 7 101 8 102 8 103 8 104 8 105 8 106 8 107 8 108 8 109 8 110 8 111 8 112 8 113 8 114 8 28 9 29 9 30 9 08 10 09 10 48 11 49 11 50 11); return %AREA; } sub set_tokyo_contest() { my %AREA = qw ( 001 0 002 0 003 0 004 0 005 0 006 0 007 0 008 0 009 0 010 0 011 0 012 0 013 0 014 0 015 0 016 0 019 0 020 0 021 0 022 0 023 0 024 0 025 0 026 0 028 0 029 0 030 0 101 0 102 0 103 0 104 0 105 0 106 0 107 0 108 0 109 0 110 0 111 0 112 0 113 0 114 0 115 0 116 0 117 0 118 0 119 0 120 0 121 0 122 0 123 0 201 0 202 0 203 0 204 0 304 0 305 0 306 0 307 0 11 1 12 1 13 1 14 1 15 1 16 1 17 1 18 2 19 2 20 2 21 2 22 3 23 3 24 3 25 3 26 3 27 3 31 4 32 4 33 4 34 4 35 4 36 5 37 5 38 5 39 5 40 6 41 6 42 6 43 6 44 6 45 6 46 6 47 6 02 7 03 7 04 7 05 7 06 7 07 7 01 8 28 9 29 9 30 9 08 10 09 10 48 11 49 11 50 11); return %AREA; } sub set_kcj_contest() { # (for show_multi_matrix) Multiplier to call area my %AREA = qw ( SY 8 RM 8 KK 8 SC 8 IS 8 NM 8 SB 8 TC 8 KR 8 HD 8 IR 8 HY 8 OM 8 OH 8 AM 7 IT 7 AT 7 YM 7 MG 7 FS 7 NI 0 NN 0 TK 1 KN 1 CB 1 ST 1 IB 1 TG 1 GM 1 YN 1 SO 2 GF 2 AC 2 ME 2 KT 3 SI 3 NR 3 OS 3 WK 3 HG 3 TY 9 FI 9 IK 9 OY 4 SN 4 YG 4 TT 4 HS 4 KA 5 TS 5 EH 5 KC 5 FO 6 SG 6 NS 6 KM 6 OT 6 MZ 6 KG 6 ON 6 OG 1 MT 1 AS 11 OC 11 EU 11 NA 11 NA 11 AF 11 ); return %AREA; } sub set_state_table(){ my %AREA = qw ( CT 1 MA 1 ME 1 NH 1 RI 1 VT 1 NY 2 NJ 2 DC 3 DE 3 PA 3 MD 3 AL 4 FL 4 GA 4 KY 4 NC 4 SC 4 TN 4 VA 4 AR 5 LA 5 MS 5 NM 5 OK 5 TX 5 CA 6 AZ 7 ID 7 MT 7 NV 7 OR 7 UT 7 WA 7 WY 7 MI 8 OH 8 WV 8 IL 9 IN 9 WI 9 CO 10 IA 10 KS 10 MN 10 MO 10 ND 10 NE 10 SD 10 AB 11 BC 11 LB 11 MB 11 NF 11 NS 11 NU 11 ON 11 QC 11 SK 11 YT 11 PEI 11 NWT 11 ); return %AREA; } sub read_cty_dat(){ # read wl_cty_dat file and create hash array my %ENTITY; # representative prefix to entity name mapping my $DEBUG = 0; my $country; my $continent; my $rep; # representative prefix ### getopts( 'h', \%opts); if (! -f $CTY_DAT ) { $CTY_DAT = $CTY_DAT_LOC;} open(CTY_DAT, $CTY_DAT) || die 'Problem opening ', $CTY_DAT, " file: $!\n"; while () { my @list = ''; if ( /([a-zA-Z &]+):\s+([0-9]+):\s+([0-9]+):\s+([AENOSN][ACFSU]):\s+[0-9-.]+:\s+[0-9-.]+:\s+[0-9-.]+:\s*(.*):/ ) { #Japan: 25: 45: AS: 36.40: -138.38: -9.0: JA: $country = $1; $continent = $4; $rep = $5; $rep =~ s/^\*//; # non entity, thanks JQ2GYU $ENTITY{$rep} = $country; $PREF_TO_CONTINENT{$rep} = $continent; # print "$rep $continent \n"; } else { chomp; s/^#\s+//; # : { # # K: K0(4)[7] s/: /,/; # convert ': ' to ',' s/;//; # remove line ending ; tr /\015//d;# remove ^M s/^\s+//; # remove leftmost blank my @to_be_added = split ',', $_; push @list, @to_be_added; } foreach my $pref (@list) { $pref =~ s/\(\d+\)//; # BY0A(23)[42] -> BY0A (CQ zone)[ITU zone] $pref =~ s/\[\d+\]//; if ( $pref =~/^=/ ) { $pref =~ s/=//; $CALLSIGN_TO_E{$pref} = $rep; } elsif ( length($pref) == 1 ) { $PREFIX1 {$pref} = $rep;} elsif ( length($pref) == 2 ) { $PREFIX2 {$pref} = $rep;} elsif ( length($pref) == 3 ) { $PREFIX3 {$pref} = $rep;} elsif ( length($pref) == 4 ) { $PREFIX4 {$pref} = $rep;} print $pref, ' ' if $DEBUG; } print "\n" if $DEBUG; } } # Judge if Callsign belogns to which continent. # It will be used unless -z is specified. sub get_continent_and_entity($){# give call sign and returns continent and entity my $find = shift; my $entity; if ($find =~ /^N/ ) { $find =~ s/^N/K/;} # N W is equivalent to K if ($find =~ /^W/ ) { $find =~ s/^W/K/;} $find =~ y/a-z/A-Z/; my $find4 = substr($find,0,4); my $find3 = substr($find,0,3); my $find2 = substr($find,0,2); my $find1 = substr($find,0,1); my $reprep; # representative prefix if ( $entity = $CALLSIGN_TO_E{$find} ) { $reprep = $find; } elsif ( $entity = $PREFIX4{$find4} ) { $reprep = $find4; } elsif ( $entity = $PREFIX3{$find3} ) { $reprep = $find3; } elsif ( $entity = $PREFIX2{$find2} ) { $reprep = $find2; } elsif ( $entity = $PREFIX1{$find1} ) { $reprep = $find1; } else { print "(0) $find $reprep Bad \n";} my $continent = $PREF_TO_CONTINENT{$reprep}; # print "(1) $find $reprep: $continent\n" if ( $continent eq ''); if ( $continent eq '') { # if not found $continent = $PREF_TO_CONTINENT{$entity}; } if ($entity eq 'JA') { $continent = 'JA';} # use JA separately from AS return ($entity, $continent);} sub get_continent_by_zone($$){ # Return continent type, used if -z is specified. my $zone = shift; my $callsign = shift; my $continent = 'DX' ; # AS OC NA SA AF EU JA if ( $zone + 1 == 1 ) { $continent = 'NA'; } # W/VE state/province if ( $zone == 25) { if ($callsign =~ m|^H| || $callsign =~ m|^D| || $callsign =~ m|^6|) { $continent = 'AS'; } else { $continent = 'JA'; } } else { if ( 1 <= $zone && $zone <= 9 ) { $continent = 'NA'; } if ( 10 <= $zone && $zone <= 13 ) { $continent = 'SA'; } if ( 14 <= $zone && $zone <= 16 ) { $continent = 'EU'; } if ( 17 <= $zone && $zone <= 26 ) { $continent = 'AS'; } if ( 27 <= $zone && $zone <= 32 ) { $continent = 'OC'; } if ( 33 <= $zone && $zone <= 39 ) { $continent = 'AF'; } if ( 40 == $zone ) { $continent = 'AT'; } } return $continent; } # ------------------------------------------ sub print_gap ($$){ # print | char if hour skips my $HOUR = shift ; my $prev_hour = shift ; my $hour = substr($HOUR, 8,2); if ($prev_hour eq '') { $prev_hour = $hour;} if ( ($hour - $prev_hour) > 1 || $prev_hour == 23 && $hour != 0 ) {# some gap found on hours print " |";} if ( $hour < $prev_hour && $hour != 0 && $prev_hour != 23 ) { print " |";} return $hour; } # ------------------- # Called only once from main sub read_cabrillo { # read cabrillo format and save the data to %MATRIX while (<>) { if (! /^QSO: /) { next;} my ($dummy, $freq, $mode, $date_string, $gmt, $a, $b, $c, $callsign, $rst, $exch); if ($opts{'D'}) { ($dummy, $freq, $mode, $date_string, $gmt, $a, $b, $callsign, $rst) = split; } else { ($dummy, $freq, $mode, $date_string, $gmt, $a, $b, $c, $callsign, $rst, $exch) = split; } my $band = get_band($freq); $BANDS{$band}++; # collect the band is used. my $hour; if ($opts{'2'} ) { $DAYS{$date_string}++; # collect the date found, $hour = $date_string.';'.substr($gmt, 0,2); #special format } else { my $tzone; $tzone = $ENV{'TZ'}; if ($tzone eq '') {$tzone = 'GMT';} if ( $opts{'t'} eq 'JST') { $tzone = 'JST';} # The example of $date_string is '2011-04-09' my $dm = dateFormat($date_string, $gmt, $tzone); $hour = substr($dm, 0,10); # 10 digits yyyyMMddHH like 2011030324 (local time) } my $continent; my $entity; if ( $opts{'z'}){ $continent = get_continent_by_zone($exch,$callsign); } else { ($entity, $continent) = get_continent_and_entity($callsign); print "(2) $callsign $entity $continent\n" if ($continent eq '');} $CONTINENTS{$continent}++; # collect the continent QSO made if ($opts{'a'} || $opts{'j'} || $opts{'T'} || $opts{'K'} ) { # ARRL or ALL JA special, by state if ( $opts{'j'} ) { $exch =~ s/[PLMH]$//;} # strip power code if ( $opts{'K'} ) { $exch =~ s/(..)[PLMH]$/$1/;} # strip power code # stripping power code for KCJ is 2010 only (non UDC log) $MULTIS{$exch}++; # exch holds state abbrevation in this case # Mainly for skipping non-QSO states. if ($opts{'m'} ) { $HISTGRAM{$exch} .= $callsign.','; } # To save exch -> callsign database $MATRIX{$hour}{$exch}++; if ($band == 1.8) { $MATRIX18{$hour}{$exch}++;} # emulates 3D array if ($band == 3.5) { $MATRIX35{$hour}{$exch}++;} if ($band == 7 ) { $MATRIX70{$hour}{$exch}++;} if ($band == 14 ) { $MATRIX14{$hour}{$exch}++;} if ($band == 21 ) { $MATRIX21{$hour}{$exch}++;} if ($band == 28 ) { $MATRIX28{$hour}{$exch}++;} } if ($CALLSIGN{$callsign}{$band}) { # duplicate check my @dupe_callsign = split ' ', $_; push(@DUPE, [$dupe_callsign[8], $_] ); next; # skip below if duplicates } $CALLSIGN{$callsign}{$band}++; # register for dupe check # $MATRIX{$hour}{$band}++; # count up by each category sub total # $MATRIX{$hour}{'total'}++; if ( ! $opts{'K'} ) { $MATRIX{$hour}{$continent}++; if ($band == 1.8) { $MATRIX18{$hour}{$continent}++;} # emulates 3D array if ($band == 3.5) { $MATRIX35{$hour}{$continent}++;} if ($band == 7 ) { $MATRIX70{$hour}{$continent}++;} if ($band == 14 ) { $MATRIX14{$hour}{$continent}++;} if ($band == 21 ) { $MATRIX21{$hour}{$continent}++;} if ($band == 28 ) { $MATRIX28{$hour}{$continent}++;} } } } sub print_title_h($\@) { # print horizontal title # --- date column (title line) ------ my $band = $_[0]; my (@HOURS) = @{$_[1]}; my $prev_date = ''; my $prev_hour = ''; printf "\n(%3s)", $band; foreach my $hour (@HOURS) { my $date = substr($hour, 6,2); $prev_hour = print_gap($hour, $prev_hour); if ($date ne $prev_date ) { printf ("%3d", $date); # print date column if number changes $prev_date = $date; } else { printf (" "); # else put blank } } print "\n"; $prev_hour = ''; # --- hour column (title line) ------ printf " "; foreach my $hour (@HOURS) { $prev_hour = print_gap($hour, $prev_hour); my $hour = substr($hour, 8,2); printf ("%3d", $hour); } printf "%4s\n", 'TOT'; $prev_hour = ''; printf " "; foreach my $hour (@HOURS) { $prev_hour = print_gap($hour, $prev_hour); my $hour = substr($hour, 8,2); printf ("%3s", '---'); } printf "%4s\n", ''; } sub show_one_band($\@\@$) { # BAND by BAND table --- called (once) unless -c ---------- my $band = $_[0]; my (@BANDS) = @{$_[1]}; my (@HOURS) = @{$_[2]}; my $calculate_sum = $_[3]; # if update $ACUM{$hour} or not my $band_total; my $prev_hour; my $bar = ' '; my $by_hour_sum; printf ("%5s", $band ); $band_total = 0; $prev_hour = ''; foreach my $hour (@HOURS) { $prev_hour = print_gap($hour,$prev_hour); if ($MATRIX{$hour}{$band} != 0 ) { printf ("%3d", $MATRIX{$hour}{$band});} else { printf (" ");} $bar .= '---'; $band_total += $MATRIX{$hour}{$band}; if ($calculate_sum == 1 ) { if ($band eq 'total' || $#BANDS == 0 ) { $by_hour_sum += $MATRIX{$hour}{$band}; $ACUM{$hour}+= $by_hour_sum; } } } printf "%4d ", $band_total; printf ("%5s\n", $band ); return $bar; } # Called only once from horizontal sub show_multi_matrix(\@\@\@\%$ ) { # show-by-multi detail --- by band not implemented my $prev_area = ''; my (@DAYS) = @{$_[0]}; my (@HOURS) = @{$_[1]}; my (@BANDS) = @{$_[2]}; my (%MULTIS)= %{$_[3]}; my $bar = $_[4]; my $by_hour_sum; my (%HOUR_TOTAL,%HOUR_SUM); my (%AREA); my %DAY_TOTAL; if ($opts{'j'}) { %AREA = set_ja_area();} elsif ($opts{'T'}) { %AREA = set_tokyo_contest();} elsif ($opts{'K'}) { %AREA = set_kcj_contest();} else { %AREA = set_state_table();} # gete @MULTIS sorted by W/K/N classic call area from %AREA table my @MULTIS = sort { if ($AREA{$a} eq $AREA{$b}) {$a cmp $b} else {$AREA{$a} <=> $AREA{$b}} } keys %MULTIS; my $accum; foreach my $band (@BANDS){ # Do by @MULTIS sorted by above, # and main information src is $MATRIX{$hour}{$state} <= # show_one_band($band); used be here but replaced if ($band == 1.8) { %MATRIX = %MATRIX18;} if ($band == 3.5) { %MATRIX = %MATRIX35;} if ($band == 7 ) { %MATRIX = %MATRIX70;} if ($band == 14 ) { %MATRIX = %MATRIX14;} if ($band == 21 ) { %MATRIX = %MATRIX21;} if ($band == 28 ) { %MATRIX = %MATRIX28;} my $day_total = 0; $accum = 0; %HOUR_TOTAL = (); %HOUR_SUM = (); %ACUM = (); foreach my $d (0..$#DAYS) { my $day = $DAYS[$d]; # $d will be used in last part printf ("%5s\n", $day); print_head($band, @HOURS); # %ACUM =(); # print_title_h($band, @HOURS); # print_head($band, @HOURS); foreach my $exch (@MULTIS) { if ($AREA{"$exch"} != $prev_area) { # place a separation bar between call area print $bar, "\n";} $prev_area = $AREA{"$exch"}; printf ("%5s", $exch ); my $exch_total = 0; my $prev_hour = ''; $by_hour_sum = 0; foreach my $hh (@HOURS) { my $hour = $hh; if ($opts{'2'}) { $hour = $day.';'.$hh; } $prev_hour = print_gap($hour,$prev_hour) if ! $opts{'Z'}; if ($MATRIX{"$hour"}{"$exch"} != 0 ) { printf ("%3d", $MATRIX{"$hour"}{"$exch"});} else { printf (" ");} $exch_total += $MATRIX{"$hour"}{"$exch"}; # HOR. sum $HOUR_TOTAL{"$hour"}+=$MATRIX{"$hour"}{"$exch"}; # VERT. sum $HOUR_SUM{"$hour"}+= $MATRIX{"$hour"}{"$exch"}; # for grand total # if ($exch eq 'total' || $#MULTIS == 0 ) { if ($exch == $MULTIS[$#MULTIS]) { # last part $by_hour_sum += $HOUR_TOTAL{"$hour"}; # HOR. # print "\$hour: $hour ->", $ACUM{"$hour"}, "<- $by_hour_sum\n"; $accum += $HOUR_TOTAL{$hour}; $ACUM{"$hour"} = $by_hour_sum; } } $DAY_TOTAL{"$exch"} += $exch_total; printf "%4d", $exch_total; if ($d == 1) { # meaning the second day. printf " %4d", $DAY_TOTAL{"$exch"}; } print "\n"; } # foreach my $exch (@MULTIS) { print_bottom(); #---------------------------------- # print sub total of today #---------------------------------- my $prev_hour = ''; printf (" %-3s", 'sub'); my $band_total = 0; foreach my $hh (@HOURS) { my $hour = $hh; if ($eachday) { $hour = $day.';'.$hour;} $prev_hour = print_gap($hour, $prev_hour) if !$opts{'Z'}; my $tmp = $HOUR_TOTAL{$hour}; $band_total += $tmp; if ($tmp != 0 ) { printf ("%3d", $tmp);} else { printf (" ");} } printf "%4d", $band_total; $day_total += $band_total; if ($d == 1) { # meaning the second day. printf " %4d", $day_total;} print "\n"; #---------------------------------- accumulated_count($day, \@HOURS, \%ACUM); } # foreach my $d (0..$#DAYS) { # %HOUR_TOTAL = {}; # %HOUR_SUM = {}; # %ACUM = (); } # foreach my $band (@BANDS){ } # sub show_multi_matrix( ) { # BY STATE table --- by band not implemented sub accumulated_count($\@\%) { # show accumulated count vertically (assuming max number is 9,999) my ($day) = $_[0]; # date array ( meaningfull only when -2 on command line) my (@HOURS) = @{$_[1]}; # 0 .. 23 (etc, can be sparse) my (%ACUM ) = %{$_[2]}; print "\n"; foreach my $c ( reverse 0 .. 3) { my $prev_hour = ''; if ($c == 2 ) {printf ' accm';} else {printf ' ';} foreach my $hh (@HOURS) { my $hour = $hh; if ($opts{'2'}) { $hour = $day.';'.$hh; } $prev_hour = print_gap($hour, $prev_hour) if !$opts{'Z'}; my ($digit) = ($ACUM{$hour}/10**$c) %10; if ($c == 3 && $digit == 0) { printf "%3s", ' ';} else { printf "%3d", $digit;}} print "\n"; }} sub print_head($\@) { # for show_continents_table (have -2 switch) my ($band) = $_[0]; my (@HOURS) = @{$_[1]}; if ($opts{'2'} ) { printf " %-3d", $band; foreach my $i ( @myhours) { printf "%02d ", $i;} print "\n"; printf " "; foreach my $i ( @myhours) { printf "%03s", '--+';} print "\n"; } else { print_title_h($band, @HOURS); } } sub print_bottom( ) { # for show_continents_table (have -2 switch) if ($opts{'2'} ) { printf " "; foreach my $i ( @myhours) { printf "%03s", '--+';} print "\n"; } } sub show_continents_table(\@\@\@\@ ) { # BY CONTINENT table ------------- # horizontal (ALMOST MAIN ROUTINE) -> show_continents_table my (@DAYS) = @{$_[0]}; my (@HOURS) = @{$_[1]}; my (@BANDS) = @{$_[2]}; my (@CONTINENTS) = @{$_[3]}; my $by_hour_sum = 0; my $prev_hour; # three level foreach @BAND -> @CONTINENTS -> @HOURS foreach my $band (@BANDS) { my %HOUR_TOTAL = (); # sum of each continent my %DAY_TOTAL = (); # keyed by continent # %ACUM = {}; # initialize for each band $by_hour_sum = 0; # show_one_band($band); used be here but replaced if ($band == 1.8) { %MATRIX = %MATRIX18;} if ($band == 3.5) { %MATRIX = %MATRIX35;} if ($band == 7 ) { %MATRIX = %MATRIX70;} if ($band == 14 ) { %MATRIX = %MATRIX14;} if ($band == 21 ) { %MATRIX = %MATRIX21;} if ($band == 28 ) { %MATRIX = %MATRIX28;} my $day_total = 0; foreach my $d (0..$#DAYS) { my $day = $DAYS[$d]; printf ("%5s\n", $day); print_head($band, @HOURS); foreach my $i ( 0 .. $#CONTINENTS) { my $continent = $CONTINENTS[$i]; printf (" %3s", $continent ); my $continent_total = 0; $prev_hour = ''; # my $first = 0; foreach my $hh (@HOURS) { my $hour = $hh; # $first++; if ($opts{'2'}) { $hour = $day.';'.$hh; } $prev_hour = print_gap($hour,$prev_hour); if ($MATRIX{$hour}{$continent} != 0 ) { printf ("%3d", $MATRIX{$hour}{$continent});} else { printf (" ");} $continent_total += $MATRIX{$hour}{$continent}; # HOR. sum $HOUR_TOTAL{$hour}+= $MATRIX{$hour}{$continent}; # VERT. sum $HOUR_SUM{$hour}+= $MATRIX{$hour}{$continent}; # for grand total if ($continent eq 'total' || $i == $#CONTINENTS ) { # do once condition $by_hour_sum += $HOUR_TOTAL{$hour}; $ACUM{"$hour"}+= $by_hour_sum; } } # foreach my $hour (@HOURS) { $DAY_TOTAL{$continent} += $continent_total; printf "%4d", $continent_total; if ($d == 1) { # meaning the second day. printf " %4d", $DAY_TOTAL{$continent};} print "\n"; } # foreach my $continent (@CONTINENTS) print_bottom(); #---------------------------------- # print sub total of today #---------------------------------- $prev_hour = ''; printf (" %-3s", 'sub'); my $band_total = 0; foreach my $hh (@HOURS) { my $hour = $hh; if ($eachday) { $hour = $day.';'.$hour;} $prev_hour = print_gap($hour,$prev_hour); my $tmp = $HOUR_TOTAL{$hour}; $band_total += $tmp; if ($tmp != 0 ) { printf ("%3d", $tmp);} else { printf (" ");} } printf "%4d", $band_total; $day_total += $band_total; if ($d == 1) { # meaning the second day. printf " %4d", $day_total;} print "\n"; #---------------------------------- if ($opts{'2'}) { accumulated_count($day, @myHOURS, %ACUM);} } # end of 'foreach my $day (@DAYS) {' } # end of 'foreach my $band (@BANDS) { if ($#BANDS > 1) { # if BANDS is two or more, show Grand total $prev_hour = ''; printf ("\n%4s", 'Grand'); my $band_total = 0; foreach my $hour (@HOURS) { # XXXX $prev_hour = print_gap($hour,$prev_hour); # if !$opts{'Z'}; my $tmp = $HOUR_SUM{$hour}; $band_total += $tmp; if ($tmp != 0 ) { printf ("%3d", $tmp);} else { printf (" ");} } printf "%4d\n", $band_total; } } # end of sub continent # ---- A L M O S T M A I N R O U T I N E ---- # called only once from main sub horizontal(\@\@\@\@\%) { # Almost M A I N Routine my (@DAYS) = @{$_[0]}; my (@HOURS) = @{$_[1]}; my (@BANDS) = @{$_[2]}; my (@CONTINENTS) = @{$_[3]}; my (%MULTIS) = %{$_[4]}; my $bar = ' -----' ; # print ---- as long as time table --- if ($opts{'c'}) { show_continents_table(@DAYS, @HOURS, @BANDS, @CONTINENTS ); } else { # -a ARRL -j JAPAN -T tokyo -K KCJ if ( $opts{'a'} || $opts{'j'} || $opts{'T'} || $opts{'K'}) { show_multi_matrix(@DAYS, @HOURS, @BANDS, %MULTIS, $bar); if ($#BANDS > 0 ) {push(@BANDS, 'total');}; # show hourly total again print "\n"; # %ACUM = {}; # initialize for each band, this needs multiband only, single harmfull if ($opts{'c'}) { foreach my $band (@BANDS) { $bar = show_one_band($band, @BANDS, @HOURS, 0); } } else { if ($#BANDS > 0 ) {push(@BANDS, 'total');}; foreach my $band (@BANDS) { $bar = show_one_band($band, @BANDS, @HOURS, 1); } } } } # print accumulated count accumulated_count(0, @HOURS, %ACUM); } # ---- M A I N ---- sub main (){ # ---- M A I N ---- getopts('2acdDe:ghjKm:s:t:vzTZ', \%opts); if ($opts{'h'}) { usage() ; exit;} if ($opts{'2'}) { $eachday++; $opts{'Z'} = 1} else { # use Date::Manip; # use DateTime::Format::DateManip; # for ParseDate() }; read_cty_dat(); read_cabrillo(); my @BANDS = sort {$a <=> $b} keys %BANDS; my @HOURS = sort keys %MATRIX; # pick @HOURS info from read_cabrillo my ($max) = $HOURS[$#HOURS]; my ($min) = $HOURS[0]; # (relatively) new variable to give two-column for DATE # my @DATE; my @DAYS = (0); my $year = substr($min,0,4); my $month = substr($min,4,2); my $min_date = substr($min, 6,2); my $min_hour = substr($min, 8,2); my $max_date = substr($max, 6,2); my $max_hour = substr($max, 8,2); # if -g is said, meaning no gap, adjust @HOURS again, using collected @HOURS if ($opts{'g'}) { @HOURS = (); push @HOURS, $year.$month.$min_date.$min_hour .. $year.$month.$min_date.'23'; if ( $max_date - $min_date > 1 ) { # three days duration my $min = $min_date + 1; push @HOURS, $year.$month.$min.'00' .. $year.$month.$min.'23'; } push @HOURS, $year.$month.$max_date.'00'.. $year.$month.$max_date.$max_hour; } # ($opts{'g'}) no gap if ( $opts{'2'}) { # by-date-format @HOURS = (); @DAYS = sort keys %DAYS; # conversion from picked one to dense array my $ends = 23, my $starts = 0; if ($opts{'e'} ) { $ends = $opts{'e'};}; if ($opts{'s'} ) { $starts = $opts{'s'};}; @myhours = ( $starts .. $ends ); # array of digigts. foreach my $i (@myhours) { push @HOURS, sprintf("%02d", $i); push @myHOURS, sprintf("%02d", $i);} } my @CONTINENTS = sort keys %CONTINENTS; # if ($eachday) { push @CONTINENTS, 'total'}; # if ( $opts{'c'} eq '') {print_title_h('All', @HOURS);} horizontal(@DAYS, @HOURS, @BANDS, @CONTINENTS, %MULTIS); if ($opts{'d'}) { print "Duplicate follows:\n"; print map { $_->[1] } sort { $a->[0] cmp $b->[0]} @DUPE; } if ($opts{'m'}) { print "Stations to give rare multis:\n"; foreach my $exch ( sort keys %MULTIS ) { if ($MULTIS{$exch} <= $opts{'m'} ) { printf "%3s : %s\n", $exch, $HISTGRAM{$exch}; } } } } # invoke main() main(); __DATA__ QSO: 7166 PH 2009-10-24 1019 JA1XMS 59 25 OX2A 59 40 __END__ TODO move @MULTIS generation outside of show_multi_matrix (giving same sort criteria for -m option) 2011/11/28: following invocation gives wrong with 7/14/21/28 combination. perl ~/perl/ham-radio/cabrillo2-time-table -a 2011-cq-ww-cw.LOG