#!/usr/bin/perl

# This script read in a Callisto schedule file from STDIN, and filters
# it so that recording is on only between sunrise and sunset. The
# result is output to STDOUT. The coordinates are read from the
# Callisto configuration file given as the first command line
# argument.
#
# Emacs calendar is used to calculate the sunrise and sunset
# times. This may seem a bit strange, but it is really hard to find a
# "standard" (here defined as available in standard Debian
# repositories) program that does it and does it right. Emacs was the
# best option of the three I managed to find, which are the following
# (with their pros and cons):
#
# Emacs calendar
#   + Emacs is a very standard package
#   + Handles polar night and day
#   - A bit heavy for just this purpose
#   - Needs timezone compensation to get both rise and set times in
#     some cases (see below)
#
# DateTime::Event::Sunrise
#   + A Perl module, would be the natural option for a Perl script
#   - Does not handle polar night or day, only carps about sun not
#     setting/rising and returns bogus times (though identical for
#     rise and set)
#   - Sometimes may get stuck in an infinite loop
#
# gcal
#   + *Seems* to handle polar night and day, at least if correct input
#     is given
#   - impossible-to-learn syntax
#   - Bug: If height above sea level is given in the coordinates, it
#     just shifts the timezoine. Who knows what other bugs there may
#     be.
#   - Not as standard as Emacs


$DEBUG = 0;
$MARGIN = 0;

# this is used to terminate a line in the output schedule:
$EOL = "\r\n";

if ($ARGV[0] eq "-d") {
    shift(@ARGV);
    $DEBUG = 1;
}

if (scalar(@ARGV) != 1 && scalar(@ARGV) != 2) {
    print(STDERR "ERROR: Usage: $0 <callisto.cfg> [<margin>]\n");
    exit 1;
}

if (scalar(@ARGV) == 2) {
    $MARGIN = int($ARGV[1]);
    if ($MARGIN < 0) {
	print(STDERR "ERROR: invalid margin\n");
	exit 1;
    }
}

# Read callisto configuration file
if (!open(F, "<$ARGV[0]")) {
    print(STDERR "ERROR: Cannot open configuration file $ARGV[0]\n");
    exit 1;
}
while ($l = <F>) {
    if ($l =~ /^\s*\[latitude\]=([NnSs]),([\d\.]+)(\s.*)$/i) {
	$LATITUDE = 1.0*$2;
	$LATITUDE = -$LATITUDE if ($1 =~ /[Ss]/);
    }
    if ($l =~ /^\s*\[longitude\]=([WwEe]),([\d\.]+)(\s.*)$/i) {
	$LONGITUDE = 1.0*$2;
	$LONGITUDE = -$LONGITUDE if ($1 =~ /[Ww]/);
    }
    if ($l =~ /^\s*\[focuscode\]=(\d\d)(\s.*)$/i) {
	$FOCUSCODE = $1;
    }
}
close(F);

if (!defined($LATITUDE) || !defined($LONGITUDE) || !defined($FOCUSCODE)) {
    print(STDERR "ERROR: Bad configuration file: $ARGV[0]\n");
    exit 1;
}

print(STDERR "long=$LONGITUDE, lat=$LATITUDE, fc=$FOCUSCODE\n") if ($DEBUG);


# Read base schedule from stdin
$total = 0;
@schedule = ();
%schedule_time = ();
%schedule_action = ();
while ($l = <STDIN>) {
    $l =~ s/^\s*//;
    next if ($l =~ /^(\/.*)?$/);

    $total++;
    if ($l =~ /^(\d\d:\d\d:\d\d,\d\d,\d)/) {
	$l = $1;
	@ll = split(/,/, $l);
	if ($ll[1] == $FOCUSCODE) {
	    push(@schedule, $l);
	    $schedule_action{$l} = $ll[2];
	    @ll = split(/:/, $ll[0]);
	    $schedule_time{$l} = 3600*$ll[0] + 60*$ll[1] + $ll[2];
	}
    } else {
	print(STDERR "WARNING: Ignoring malformed schedule entry: $l");
    }
}
@schedule = sort(@schedule);
print(STDERR "Base schedule:\n ", join("\n ", @schedule), "\n") if ($DEBUG);

if (!scalar(@schedule) && $total) {
    print(STDERR "WARNING: Empty schedule for FC $FOCUSCODE\n");
}

# find latest start/stop action in the schedule:
$action = 3; # default to start (i.e. always on)
for $s (@schedule) {
    if ($schedule_action{$s} =~ /^[023]$/) {
	$action = $schedule_action{$s};
    }
}
print(STDERR "Last action: $action\n") if ($DEBUG);


# find sunrise and sunset times for this UTC date:
($Year, $Month, $Day) = utc_day(time());
($up, $dn) = emacs_sunrise($LATITUDE, $LONGITUDE, $Year, $Month, $Day);
exit 1 if ($up < 0 || $dn < 0);

if ($up <= $dn) {
    $nightlen = 86400 - ($dn - $up);
} else {
    $nightlen = $up - $dn;
}

if ($nightlen < 2*$MARGIN) {
    # night is too short to apply margin, turn schedule into polar day:
    $up = 0;
    $dn = 86400;
} elsif ($nightlen < 86400) {
    # if there is a day, lengthen it from both ends by margin seconds:
    $up = (86400 + $up - $MARGIN) % 86400;
    $dn = ($dn + $MARGIN) % 86400;
}


# print the filtered schedule
print("// Schedule file generated by callisto-sunschedule.$EOL");
$s = 0;
$n = scalar(@schedule);
if ($up < $dn) { # night-day-night
    while ($s < $n && $schedule_time{$schedule[$s]} <= $up) {
	if ($schedule_action{$schedule[$s]} =~ /^[023]$/) {
	    $action = $schedule_action{$schedule[$s]};
	} elsif ($schedule_action{$schedule[$s]} eq "8") {
	    print($schedule[$s], $EOL);
	}
	$s++;
    }

    printf("%02u:%02u:%02u,%02u,%u$EOL",
	   int($up / 3600), int($up / 60) % 60, $up % 60,
	   $FOCUSCODE,
	   $action);

    while ($s < $n && $schedule_time{$schedule[$s]} < $dn) {
	print($schedule[$s], $EOL);
	$s++;
    }

    if ($dn < 86400) {
	printf("%02u:%02u:%02u,%02u,0$EOL",
	       int($dn / 3600), int($dn / 60) % 60, $dn % 60,
	       $FOCUSCODE);
    }

    while ($s < $n) {
	if ($schedule_action{$schedule[$s]} eq "8") {
	    print($schedule[$s], $EOL);
	}
	$s++;
    }

} else { # day-night-day
    while ($s < $n && $schedule_time{$schedule[$s]} < $dn) {
	if ($schedule_action{$schedule[$s]} =~ /^[023]$/) {
	    $action = $schedule_action{$schedule[$s]};
	}
	print($schedule[$s], $EOL);
	$s++;
    }

    printf("%02u:%02u:%02u,%02u,0$EOL",
	   int($dn / 3600), int($dn / 60) % 60, $dn % 60,
	   $FOCUSCODE);

    while ($s < $n && $schedule_time{$schedule[$s]} <= $up) {
	if ($schedule_action{$schedule[$s]} =~ /^[023]$/) {
	    $action = $schedule_action{$schedule[$s]};
	} elsif ($schedule_action{$schedule[$s]} eq "8") {
	    print($schedule[$s], $EOL);
	}
	$s++;
    }

    if ($up < 86400) {
	printf("%02u:%02u:%02u,%02u,%u$EOL",
	       int($up / 3600), int($up / 60) % 60, $up % 60,
	       $FOCUSCODE,
	       $action);
    }

    while ($s < $n) {
	print($schedule[$s], $EOL);
	$s++;
    }

}









sub utc_day {
    my @t = gmtime($_[0]);
    return ($t[5]+1900, $t[4]+1, $t[3]);
}

sub emacs_sunrise_query {
    my ($LAT, $LON, $Y, $M, $D, $TZ) = @_;
    my $sr =
	"(let* (".
	"       (srdate '($M $D $Y))".
	"       (calendar-latitude $LAT)".
	"       (calendar-longitude $LON)".
	"       (calendar-daylight-savings-starts nil)".
	"       (calendar-daylight-savings-starts nil)".
	"       (calendar-time-zone $TZ)".
	"       (sr (solar-sunrise-sunset srdate))".
	"      )".
	"  (print (car (car sr)))".
	"  (print (car (car (cdr sr))))".
	"  (print (car (cdr (cdr sr))))".
	"  (print (solar-sunrise-sunset-string srdate))".
	")";

    @answer = `emacs -batch --eval "(require 'solar)" --eval "$sr" 2>/dev/null | grep -v ^\$`;
    
    for my $a (@answer) {
	chomp($a);
	$a =~ s/\"//g;
    }
    return @answer;
}

sub emacs_sunrise {
    my ($LAT, $LON, $Y, $M, $D) = @_;
    my $TZ = 0;

    my ($up, $dn, $len, $str) =
	emacs_sunrise_query($LAT, $LON, $Y, $M, $D, $TZ);
    print(STDERR "emacs_sunrise: $up -> $dn ($len) \@0\n") if ($DEBUG);

    if ($len eq "0:00") {
	print(STDERR "Polar night\n") if ($DEBUG);
	return (86400, 0);
    } elsif ($len eq "24:00") {
	print(STDERR "Polar day\n") if ($DEBUG);
	return (0, 86400);
    } elsif ($up eq "nil" && $dn eq "nil") {
	print(STDERR "ERROR: no sunrise or sunset but day length is $len\n");
	return (-1 -1);
    }
    
    if ($up eq "nil") {
	$TZ = int(60*(24.0 - $dn)) - 1;
	($up, $dn, $len, $str) =
	    emacs_sunrise_query($LAT, $LON, $Y, $M, $D, $TZ);
    } elsif ($dn eq "nil") {
	$TZ = int(-60*$up) + 1;
	($up, $dn, $len, $str) =
	    emacs_sunrise_query($LAT, $LON, $Y, $M, $D, $TZ);
    }
    
    if ($up eq "nil" || $dn eq "nil") {
	# The compensation is +-minute, so *very* short night/day will
	# cause this even with compensation
	if ($len =~ /^0:0[123]$/) {
	    print(STDERR "Almost polar night\n") if ($DEBUG);
	    return (86400, 0);
	} elsif ($len =~ /^23:5[789]$/) {
	    print(STDERR "Almost polar day\n") if ($DEBUG);
	    return (0, 86400);
	} else {
	    print(STDERR "ERROR: no sunrise/sunset but day length is ".
		  "significant ($len)\n");
	    return (-2, -2);
	}
    }
    print(STDERR "emacs_sunrise(compensated): $up -> $dn ($len) \@$TZ\n") if ($DEBUG);
    
    $up -= $TZ/60;
    $dn -= $TZ/60;
    $up += 24 if ($up < 0);
    $up -= 24 if ($up >= 24);
    $dn += 24 if ($dn < 0);
    $dn -= 24 if ($dn >= 24);
    
    if ($up < $dn) {
	print(STDERR "Final(NDN): $up -> $dn ($len) \@0\n") if ($DEBUG);
    } else {
	print(STDERR "Final(DND): $up -> $dn ($len) \@0\n") if ($DEBUG);
    }
    
    return (int(3600*$up), int(3600*$dn));
}
