#!/usr/bin/perl

use strict;
use utf8;

use CGI;
use Time::HiRes	qw( usleep );

my	$ec = 1;



###
### subs
###

# r=on/off/blink
# y=on/off/blink
# g=on/off/blink

sub	makePatCommand
{
	my( $q ) = @_;

	my	@on = ( 0x30 , 0x30 );
	my	@off = ( 0x30 , 0x30 );

	if( $q->param('r') eq "on" )
	{
		$off[0] |= 0x02;
		$on[1] |= 0x01;
	}
	elsif( $q->param('r') eq "blink" )
	{
		$off[1] |= 0x01;
		$on[0] |= 0x02;
	}
	elsif( $q->param('r') eq "off" )
	{
		$off[1] |= 0x01;
		$off[0] |= 0x02;
	}

	if( $q->param('y') eq "on" )
	{
		$on[1] |= 0x02;
		$off[0] |= 0x04;
	}
	elsif( $q->param('y') eq "blink" )
	{
		$off[1] |= 0x02;
		$on[0] |= 0x04;
	}
	elsif( $q->param('y') eq "off" )
	{
		$off[1] |= 0x02;
		$off[0] |= 0x04;
	}

	if( $q->param('g') eq "on" )
	{
		$off[0] |= 0x08;
		$on[1] |= 0x04;
	}
	elsif( $q->param('g') eq "blink" )
	{
		$off[1] |= 0x04;
		$on[0] |= 0x08;
	}
	elsif( $q->param('g') eq "off" )
	{
		$off[1] |= 0x04;
		$off[0] |= 0x08;
	}

	my	@command = ( 
		"\@??0" . chr( $off[0] ) . chr( $off[1] ) . "!" ,
		"\@??1" . chr( $on[0] ) . chr( $on[1] ) . "!" ,
	);

	$command[0] = "" if $command[0] eq "@??000!";
	$command[1] = "" if $command[1] eq "@??100!";

	return @command;
}

###
### main
###

my	$fh;

EXCEPTION : {

	my	$q = new CGI;
	my	$tty = "/dev/ttyS0";

	if( !open( $fh , "+<$tty" ) )
	{
		print STDERR "*** failed to open $tty : $!\n";
		print $q->header( 
			"-status"		=> "500" ,
		);
		last EXCEPTION;
	}


	my	$written = 0;

	my	@command = makePatCommand( $q );
	if( $command[0] ne "" )
	{
		syswrite $fh , "$command[0]\n";
		$written = 1;
	}

	if( $command[1] ne "" )
	{
		usleep( 100 ) if $written;
		syswrite $fh , "$command[1]\n";
	}


	print $q->header( 
		"-type"		=> "text/plain" ,
		"-pragma"	=> "no-cache" ,
		"-expires"	=> "-1d" ,
	);


	print <<EOF;
$command[0]
$command[1]
done.
EOF

	$ec = 0;
}

close $fh if $fh;

exit $ec;