#!/usr/bin/perl -w

use warnings FATAL => 'all';
use strict;
use English;

use constant FALSE => 0;
use constant TRUE  => !FALSE();

$WARNING = TRUE();

$OUTPUT_AUTOFLUSH = TRUE();

use LWP::UserAgent ();
use MIME::Base64 ();

use CGI::Pretty();

# These match up to the automatically generated Compool commands
use constant CommandStatus => "Test_compool_status";
#use constant CommandSetTime => "Test_compool_set~time";
#use constant CommandResetPoolTemp => "Test_compool_reset~pool~temp";
#use constant CommandRestSpaTemp => "Test_compool_reset~spa~temp";
use constant CommandIncPoolTemp => "Test_compool_inc~pool~temp";
use constant CommandIncSpaTemp => "Test_compool_inc~spa~temp";
use constant CommandDecPoolTemp => "Test_compool_dec~pool~temp";
use constant CommandDecSpaTemp => "Test_compool_dec~spa~temp";
use constant CommandTogglePool => "Test_compool_toggle~pool";
use constant CommandToggleSpa => "Test_compool_toggle~spa";
use constant CommandToggleSpaBooster => "Test_compool_toggle~spa~booster";
use constant CommandTogglePoolLight => "Test_compool_toggle~pool~light";
use constant CommandToggleSpaLight => "Test_compool_toggle~spa~light";
use constant CommandToggleWaterfall => "Test_compool_toggle~waterfall";
use constant CommandToggleCleaner => "Test_compool_toggle~cleaner";

# These are extra meta commands from form buttons
use constant ButtonPoolOn => "Button_pool_on";
use constant ButtonSpaOn => "Button_spa_on";
use constant ButtonLightsOn => "Button_lights_on";
use constant ButtonAllOff => "Button_all_off";

use constant Commands => (CommandStatus(),
			  CommandIncPoolTemp(),
			  CommandIncSpaTemp(),
			  CommandDecPoolTemp(),
			  CommandDecSpaTemp(),
			  CommandTogglePool(),
			  CommandToggleSpa(),
			  CommandTogglePoolLight(),
			  CommandToggleSpaLight(),
			  CommandToggleWaterfall(),
			  CommandToggleCleaner());

use constant CommandDefault => CommandStatus();

use constant StateAirTemperature => "Air Temperature";
use constant StateCleaner => "Cleaner";
use constant StateFreezemode => "Freeze mode";
use constant StateHeater => "Heater";
use constant StatePool => "Pool";
use constant StatePoolDesiredTemperature => "Pool Desired Temperature";
use constant StatePoolLight => "Pool Light";
use constant StatePoolTemperature => "Pool Temperature";
use constant StateServicemode => "Service mode";
use constant StateSolar => "Solar";
use constant StateSpa => "Spa";
use constant StateSpaBooster => "Spa Booster";
use constant StateSpaDesiredTemperature => "Spa Desired Temperature";
use constant StateSpaLight => "Spa Light";
use constant StateSpaTemperature => "Spa Temperature";
use constant StateTime => "Time";
use constant StateWaterfall => "Waterfall";

use constant States => (
    StateTime(),
    StateAirTemperature(),
    StatePoolTemperature(),
    StateSpaTemperature(),

    StatePoolDesiredTemperature(),
    StateSpaDesiredTemperature(),

    StatePool(),
    StateSpa(),
    StateSpaBooster(),
    StatePoolLight(),
    StateSpaLight(),
    StateWaterfall(),
    StateCleaner(),

    StateHeater(),
    StateSolar(),
    StateServicemode(),
    StateFreezemode());

use constant TypeText => "Text";
use constant TypeTemperature => "Temperature";

use constant ReadOnlyStates => {
    StateTime()             => TypeText(),
    StateAirTemperature()   => TypeTemperature(),
    StatePoolTemperature()  => TypeTemperature(),
    StateSpaTemperature()   => TypeTemperature(),
    StateHeater()           => TypeText(),
    StateSolar()            => TypeText(),
    StateServicemode()      => TypeText(),
    StateFreezemode()       => TypeText(),
};

use constant Inc => "[+]";
use constant Dec => "[-]";

use constant TemperatureDesiredStates => {
    StatePoolDesiredTemperature() => { Inc() => CommandIncPoolTemp(), Dec() => CommandDecPoolTemp() },
    StateSpaDesiredTemperature()  => { Inc() => CommandIncSpaTemp(),  Dec() => CommandDecSpaTemp()  },
};

use constant ToggleStates => {
    StatePool()       => CommandTogglePool(),
    StateSpa()        => CommandToggleSpa(),
    StateSpaBooster() => CommandToggleSpaBooster(),
    StatePoolLight()  => CommandTogglePoolLight(),
    StateSpaLight()   => CommandToggleSpaLight(),
    StateWaterfall()  => CommandToggleWaterfall(),
    StateCleaner()    => CommandToggleCleaner(),
};


use constant ParamCmd => "select_cmd";
use constant ParamMessage => "message";
sub params ($@) {
    my ($command, $message) = @_;
    my $params = "";
    if ($command ne CommandDefault()) {
	$params .= ParamCmd()."=".$command;
    }
    if (defined($message) && $message ne "") {
	my $encoded = MIME::Base64::encode_base64($message,"");
	$params .= "&".ParamMessage()."=".$encoded;
    }
    return ($params eq "") ? "" : "?".$params;
}


use constant StateOff => "off";
use constant StateOn => "on";
sub opposite ($) {
    my ($value) = @_;
    if ($value eq StateOff()) {
	return StateOn();
    }
    if ($value eq StateOn()) {
	return StateOff();
    }
    die("Unknown state $value");
}

sub main () {
    my $cgi = CGI::Pretty->new();
    
    # form buttons first
    if ($cgi->param(ButtonPoolOn())) {
	waitForGroup($cgi, StateOn(), StatePool(), StatePoolLight());
	return;
    } 
    if ($cgi->param(ButtonSpaOn())) {
	waitForGroup($cgi, StateOn(), StatePool(), StateSpa(), StateSpaBooster(), StateSpaLight());
	return;
    }
    if ($cgi->param(ButtonLightsOn())) {
	waitForGroup($cgi, StateOn(), StatePoolLight(), StateSpaLight());
	return;
    }
    if ($cgi->param(ButtonAllOff())) {
	my $toggleStates = ToggleStates();
	waitForGroup($cgi, StateOff(), keys(%{$toggleStates}));
	return;
    }

    # now look for a command
    my $command = $cgi->param(ParamCmd());
    # if none, default it
    if (!defined($command)) {
	$command = CommandDefault();
    }
    # make sure command is valid
    if (!grep { $command eq $_ } Commands()) {
	print("Unknown command $command\n");
	exit 1;
    }
    # process command
    if ($command eq CommandStatus()) {
	printStatus($cgi);
    } elsif ($command eq CommandIncPoolTemp()) {
	waitForTemperature($cgi, $command, StatePoolDesiredTemperature(), +1);
    } elsif ($command eq CommandDecPoolTemp()) {
	waitForTemperature($cgi, $command, StatePoolDesiredTemperature(), -1);
    } elsif ($command eq CommandIncSpaTemp()) {
	waitForTemperature($cgi, $command, StateSpaDesiredTemperature(), +1);
    } elsif ($command eq CommandDecSpaTemp()) {
	waitForTemperature($cgi, $command, StateSpaDesiredTemperature(), -1);
    } elsif ($command eq CommandTogglePool()) {
	waitForToggle($cgi, $command, StatePool());
    } elsif ($command eq CommandToggleSpa()) {
	waitForToggle($cgi, $command, StateSpa());
    } elsif ($command eq CommandToggleSpaBooster()) {
	waitForToggle($cgi, $command, StateSpaBooster());
    } elsif ($command eq CommandTogglePoolLight()) {
	waitForToggle($cgi, $command, StatePoolLight());
    } elsif ($command eq CommandToggleSpaLight()) {
	waitForToggle($cgi, $command, StateSpaLight());
    } elsif ($command eq CommandToggleWaterfall()) {
	waitForToggle($cgi, $command, StateWaterfall());
    } elsif ($command eq CommandToggleCleaner()) {
	waitForToggle($cgi, $command, StateCleaner());
    } else {
	print("Unknown command $command\n");
	exit 1;
    }
}

sub waitForToggle ($$$) {
    my ($cgi, $command, $state) = @_;
    my $status = status();
    waitForStateChange($cgi, 
		       $command, 
		       $status,
		       opposite($status->{$state}),
		       $state, 
		       TRUE());
}

sub waitForTemperature ($$$) {
    my ($cgi, $command, $state, $delta) = @_;
    my $status = status();
    waitForStateChange($cgi, 
		       $command, 
		       $status,
		       $status->{$state} + $delta,
		       $state,
		       TRUE());
}

sub waitForGroup ($$@) {
    my ($cgi, $target, @states) = @_;
    my $status = status();
    
    my @notes = ();
    foreach my $state (@states) {
	my $command = ToggleStates()->{$state};
	if (!defined($command)) {
	    die("No command for state $state");
	}
	my $note = waitForStateChange($cgi, 
				      $command, 
				      $status,
				      $target,
				      $state,
				      FALSE());
	if ($note ne "") {
	    push(@notes, $note);
	}
    }
    my $message = join("\n", @notes);
    redirectStatus($cgi, $message);
}

sub waitForStateChange ($$$$$$) {
    my ($cgi, $command, $status, $target, $state, $redirect) = @_;

    my $original = $status->{$state};
    if ($original eq $target) {
	# nothing to do
	if ($redirect) {
	    redirectStatus($cgi);
	}
	return "";
    }

    my $timeout = 5;
    command($command);
   
    my $startTimeInSeconds = time();
    do {
	$status = status();
	
	if ($status->{$state} eq $target) {
	    my $message = "Changed $state from $original to $target";
	    if ($redirect) {
		redirectStatus($cgi, $message);
	    }
	    return $message;
	}
	if (time() - $startTimeInSeconds > $timeout) {
	    my $message = "Could not observe change of $state from $original to $target after $timeout seconds.";
	    if ($redirect) {
		redirectStatus($cgi, $message);
	    }
	    return $message;
	}
    } while (TRUE());
}

sub redirectStatus ($@) {
    my ($cgi, $message) = @_;
    my $base = $cgi->url();
    my $params = params(CommandStatus(), $message);
    my $url = $base.$params;
    print $cgi->redirect($url);
}

sub printStatus ($) {
    my ($cgi) = @_;

    print($cgi->header());

    my $title = "Pool";
    print($cgi->start_html(-title=>$title));
    print($cgi->h1($title));

    print($cgi->a({href=>$cgi->url()}, "[Refesh]"));

    my $message = $cgi->param(ParamMessage());
    if (defined($message)) {
	print($cgi->h2("Notice"));
	my $decoded = MIME::Base64::decode_base64($message);
	# shouldn't have any markup
	if ($decoded !~ m/[<>]/) {
	    print(join($cgi->br(), split(/[\n]/, $decoded)));
	}
    }

    my $status = status();

    print($cgi->h2("Current time and temp"));
    print($cgi->table(printState($cgi, $status, StateTime()),
		      printState($cgi, $status, StateAirTemperature()),
		      printState($cgi, $status, StatePoolTemperature()),
		      printState($cgi, $status, StateSpaTemperature()),
		      $cgi->Tr($cgi->td($cgi->a({href=>"http://carlstrom.com/pool/"}, "[Temperature Graphs]")))));
    
    print($cgi->h2("Group Controls"));
    print($cgi->start_form(-method=>"GET").
	  $cgi->submit(-name=>ButtonPoolOn(),   -value=>"All pool on").
	  $cgi->end_form());
    print($cgi->start_form(-method=>"GET").
	  $cgi->submit(-name=>ButtonSpaOn(),    -value=>"All spa on").
	  $cgi->end_form());
    print($cgi->start_form(-method=>"GET").
	  $cgi->submit(-name=>ButtonLightsOn(), -value=>"All lights on").
	  $cgi->end_form());
    print($cgi->start_form(-method=>"GET").
	  $cgi->submit(-name=>ButtonAllOff(),   -value=>"All off").
	  $cgi->end_form());

    print($cgi->h2("Individual Controls"));
    print($cgi->table(printState($cgi, $status, StatePoolDesiredTemperature()),
		      printState($cgi, $status, StateSpaDesiredTemperature()),
		      printState($cgi, $status, StatePool()),
		      printState($cgi, $status, StateSpa()),
		      printState($cgi, $status, StateSpaBooster()),
		      printState($cgi, $status, StatePoolLight()),
		      printState($cgi, $status, StateSpaLight()),
		      printState($cgi, $status, StateWaterfall()),
		      printState($cgi, $status, StateCleaner())));

    print($cgi->h2("Status"));
    print($cgi->start_table());
    foreach my $state (States()) {
	my $value = $status->{$state};
	if (defined($value)) {
	    print($cgi->Tr($cgi->td([$state, $value])));
	}
    }
    print($cgi->end_table());

    print($cgi->end_html());
}

sub printState($$) {
    my ($cgi, $status, $state) = @_;

    my $value = state($status, $state);
    if (!defined($value)) {
	die("Undefined value for $state");
    }

    my $readOnlyType = ReadOnlyStates()->{$state};
    if (defined($readOnlyType)) {
	if ($readOnlyType eq TypeText()) {
	    return $cgi->Tr($cgi->td([$state, $value]));
	}
	if ($readOnlyType eq TypeTemperature()) {
	    return $cgi->Tr($cgi->td([$state, $value."&deg;F"]));
	}
	die("Unknown read only type $readOnlyType");
    }
    my $temperatureControl = TemperatureDesiredStates()->{$state};
    if (defined($temperatureControl)) {
	return $cgi->Tr($cgi->td([$state, $value."&deg;F",
				  $cgi->a({href=>params($temperatureControl->{Inc()})}, Inc()),
				  $cgi->a({href=>params($temperatureControl->{Dec()})}, Dec())]));
    }
    my $toggleStateCommand = ToggleStates()->{$state};
    if (defined($toggleStateCommand)) {
	return $cgi->Tr($cgi->td([$state, $cgi->a({href=>params($toggleStateCommand)}, $value)]));
    }
    die("Unknown state type $state for value $value");
}

sub state ($$) {
    my ($status, $state) = @_;
    return delete $status->{$state};
}

sub url ($) {
    my ($command) = @_;
    # Found URL format and arguments from:
    # - http://lilred-wireless:8080
    # - MrHouse Home
    # - Browse Categories
    # - Bdc compool test
    # See also mh/lib/http_server.pl
    
    # Note using 127.0.0.1 (instead of redbull) skip password because of password_allow_clients
    return "http://127.0.0.1:8080/bin/RUN;last_response?select_cmd=$command";
}

sub command ($) {
    my ($command) = @_;
    my $url = url($command);
    my $ua = new LWP::UserAgent();
    my $response = $ua->get($url);
    if (!$response->is_success()) {
	die("problem sending command $url\n".$response->status_line());
    }
    my $content = $response->content();
    return $content;
}

sub status () {
    my $content = command(CommandStatus);
    my $status = {};
    my @lines = split(/[\r\n]+/, $content);
    foreach my $line (@lines) {
	my (undef, $name1, $value1, undef) = ($line =~ m/ (AM|PM) (.*) is +: ([^ ]*)( degrees)?$/);
	if (defined($name1)) {
	    $status->{$name1} = $value1;
	    next;
	}
	my (undef, $name2, $value2, undef) = ($line =~ m/^<br>(The )?(.*) is +: ([^ ]*)( degrees)?$/);
	if (defined($name2)) {
	    $status->{$name2} = $value2;
	    next;
	}
    }
    return $status;
}


main();
