#!/usr/pkg/bin/perl
# $Id: cabrillo2-time-table,v 1.38 2011/03/12 02:21:41 makoto Exp $
use strict;
use Date::Manip;
use DateTime::Format::DateManip;  # for ParseDate()
use Getopt::Std;

my(%opts);
# my $TZ = 900; # offet from GMT, not used for now

# global variables written by read_cabrillo
our %MATRIX;
our %BANDS;
our %CONTINENTS;
our %STATES;
our %CALLSIGN; # call sign database to check dupes
our @DUPE;

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 
);

sub usage (){
    print <<HELP;
$0
    Generate band/hour table from cabrillo format
synopsys:
   [perl] $0 [-a] [-c] [-d] [-h] [-t JST] [-v] [-w] [-z]< cabrillo_file
where:
   -a	ARRL DX contest special, show by-STATES detail
   -c	show Continent summary too, -z also helps. (currently limited to KCJ)
   -d	show DUPE found also
   -h	show this help
   -t	Normally, time is in GMT. If it is already converted to JST, use
   	-t JST
   -v	print vertically (default -> horizontally)
   -w	output wide format (currently default, option not implemented yet)
   -z	exchange in cabrillo file has zone (and/or VE/W state), and utilize it.
 The Header shows hours in your local time. To get in UTC, use
 env TZ=utc  [perl] $0 [-h] [-t JST] < cabrillo_file

HELP
}
##   -u	The output time table in UTC

# ------------------------------------------
# convert (2009-10-12, gmt, time_zone) type string to Manip format 20091012T12:34:00

sub dateFormat ($$$){
    my $date_string	= shift;
    my $gmt		= shift;
    my $Tzone		= shift;
    my $hh = substr($gmt,0,2);
    my $mm = substr($gmt,2,2);
    my $dm = ParseDate("$date_string $hh:$mm $Tzone");
    return $dm;
}
sub get_band($){
    my $freq = shift;
    my $band;
    if    ($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 < 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;
 }
# Judge if Callsign belogns to which continent. Too rough to use.
# It will be used unless -z is specified.
sub get_continent_or_ja($){
    my $callsign = shift;
    my $continent = 'DX' ;  # AS OC NA SA AF EU JA
    if ($callsign =~ m|^J[AEFGHIJKLMNOPQRS]|)	{ $continent = 'JA';}
    if ($callsign =~ m|^7[KLMN]|)		{ $continent = 'JA';}
    if ($callsign =~ m|^[KNW]|) { 
	if ($callsign =~ m|^[KW]H|)		{ $continent = 'OC';}
    	elsif ($callsign =~ m|^KL|)		{ $continent = 'NA';}
	else				    	{ $continent = 'NA';}
    }
    if ($callsign =~ m|^A[ABCD]|)		{ $continent = 'NA';}
    if ($callsign =~ m|^V[AE]|	)		{ $continent = 'NA';}
    return $continent;
		       }
# Return continent type, used if -z is specified.
sub get_continent_by_zone($$){
    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 ($$){
    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;
}
# -------------------
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, $zone)
	    = split;
	my $band = get_band($freq);
	$BANDS{$band}++;		# collect the band is used.
	my $tzone; 
	$tzone = $ENV{'TZ'};
	if ($tzone eq '') {$tzone = 'GMT';}
	if ( $opts{'t'} eq 'JST') { $tzone = 'JST';}
	my $dm = dateFormat($date_string, $gmt, $tzone);
	my $hour = substr($dm, 0,10);
	my $continent;
	if ( $opts{'z'}){ $continent = get_continent_by_zone($zone,$callsign); 	} 
	else 		{ $continent = get_continent_or_ja($callsign);	}
	$CONTINENTS{$continent}++;	# collect the continent QSO made
	if ($opts{'a'})  { 
	    $STATES{$zone}++;
	    $MATRIX{$hour}{$zone}++,	    
	}
	if ($CALLSIGN{$callsign}{$band}) {
	    my @dupe_callsign = split ' ', $_;
	    push(@DUPE, [$dupe_callsign[8], $_] ); next;
	}
	$CALLSIGN{$callsign}{$band}++;
	$MATRIX{$hour}{$band}++,
	$MATRIX{$hour}{'total'}++,
	$MATRIX{$hour}{$continent}++,
	"\n";
    }
}
sub print_title_h(\@) { # print horizontal title
# --- date column (title line) ------
    my (@HOURS) = @{$_[0]};
    my $prev_date = '';
    my $prev_hour = '';
    printf "     ";
    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'; }

# ---- M A I N  R O U T I N E ----
sub horizontal(\@\@\@\@) {
    my (@HOURS) = @{$_[0]};
    my (@BANDS) = @{$_[1]};
    my (@CONTINENTS) = @{$_[2]};
    my (@STATES) = @{$_[3]};
    my %ACUM; # save acumulated count by hour.
    my ($band_total, $acum, $prev_hour);
    my ($continent_total);
    my ($state_total);
    my $bar = '      -----' ; # print ---- as long as time table ---
# will be moved later
sub show_continents_table( ) {
# BY CONTINENT table -------------
    foreach my $continent (@CONTINENTS) {
	printf ("%5s", $continent );
	$continent_total = 0;
	$prev_hour = '';
	foreach my $hour (@HOURS) {
	    $prev_hour = print_gap($hour,$prev_hour);
	    if  ($MATRIX{$hour}{$continent} != 0 )	{ printf ("%3d", $MATRIX{$hour}{$continent});}
	    else 				{ printf ("   ");}
	    $continent_total += $MATRIX{$hour}{$continent};
	    if ($continent eq 'total' || $#CONTINENTS == 0 ) { 
		$acum +=  $MATRIX{$hour}{$continent};
		$ACUM{$hour} = $acum; } }
	printf "%4d\n", $continent_total; }
    }

sub show_states_table( ) {
# BY STATE table -------------
    my $prev_area = '';
    foreach my $state (@STATES) {
	if ($AREA{$state} !=  $prev_area) { 
	    print $bar, "\n";}
	$prev_area = $AREA{$state};
	printf ("%5s", $state );
	$state_total = 0;
	$prev_hour = '';
	foreach my $hour (@HOURS) {
	    $prev_hour = print_gap($hour,$prev_hour);
	    if  ($MATRIX{$hour}{$state} != 0 )	{ printf ("%3d", $MATRIX{$hour}{$state});}
	    else 				{ printf ("   ");}
	    $state_total += $MATRIX{$hour}{$state};
	    if ($state eq 'total' || $#STATES == 0 ) { 
		$acum +=  $MATRIX{$hour}{$state};
		$ACUM{$hour} = $acum; } }
	printf "%4d\n", $state_total; }
    }

# BAND by BAND table -------------
    if ($#BANDS > 0 ) {push(@BANDS, 'total');};
    foreach my $band (@BANDS) {
	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 ($band eq 'total' || $#BANDS == 0 ) { 
		$acum +=  $MATRIX{$hour}{$band};
		$ACUM{$hour} = $acum; } }
	printf "%4d\n", $band_total; }

# Output only if -c is specified
    if ( $opts{'c'}) {
	show_continents_table( );
    }
    if ( $opts{'a'}) {
	show_states_table( );
    }
# print acumulated count
    $prev_hour = '';

if (0) {
    foreach my $hour (@HOURS) {
	$prev_hour = print_gap($hour,$prev_hour);
	if ($ACUM{$hour} != 0 && $hour%2 == 0 )	{ printf ("%3d", $ACUM{$hour});}
	else 					{ printf ("   ");}}
}
# show acumulated count vertically (assuming max number is 9,999)
print "\n";
foreach my $c (3,2,1,0) {
    $prev_hour = '';
    if ($c == 2 ) {printf 'acuml';}
    else          {printf '     ';}
    foreach my $hour (@HOURS) {
	$prev_hour = print_gap($hour,$prev_hour);
	my ($digit) = ($ACUM{$hour}/10**$c) %10;
	if ($c == 3 && $digit == 0)	{ printf "%3s", ' ';}
	else 				{ printf "%3d", $digit;}
    }
    print "\n"; }
}
# ----  M A I N ----
getopts('acdt:hvz', \%opts);
if ($opts{'h'}) { usage() ; exit;}
read_cabrillo();

my @BANDS = sort {$a <=> $b} keys %BANDS;
my @HOURS = sort keys %MATRIX;
my @CONTINENTS = sort keys %CONTINENTS;
my @STATES = sort { if ($AREA{$a} eq $AREA{$b}) {$a cmp $b}
		    else {$AREA{$a} <=> $AREA{$b}} 
			} keys %STATES;

print_title_h(@HOURS);
horizontal(@HOURS, @BANDS, @CONTINENTS, @STATES);

if ($opts{'d'}) { 
    print "Duplicate follows:\n";
    print map { $_->[1] } sort { $a->[0] cmp $b->[0]} @DUPE;
}
__DATA__
QSO:  7166 PH 2009-10-24 1019 JA1XMS        59  25     OX2A          59  40      
__END__