#
# Module to do serial handling on perl FileHandles
#

use strict;

package DWeather::Serial;

use POSIX qw(:termios_h);
use Fcntl;

use AnyEvent;
use base qw(AnyEvent::Handle);


# Linux-specific Baud-Rates (for reference really)
use constant B57600 => 0010001;
use constant B115200 => 0010002;
use constant B230400 => 0010003;
use constant B460800 => 0010004;
use constant CRTSCTS => 020000000000;

#
# my $h = DWeather::Serial->new("/dev/ttyXXX", 19200 [,cs7] [,odd] [,rtscts]);
#
# all parameters are optional
#
# you are expected to add AE callbacks as required, all this module
# does is create the AE::Handle and associates an IO::File handle with it
#
# default is /dev/ttyS0, 9600 8N1 no handshaking
#
# the tty is set to raw mode.
#
# returns a subclassed AE::Handle
#
sub new
{
	my $pkg = shift;
	my $class = ref $pkg || $pkg;
	my $device = shift || "/dev/ttyS0";

	my $fh = IO::File->new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;
	my $self = $class->new(fh => $fh);

	# get my attributes
	$self->{ORIGTERM} = POSIX::Termios->new();
	my $term =  $self->{TERM} = POSIX::Termios->new();
	$self->{ORIGTERM} = $self->{ORIGTERM}->getattr(fileno($fh));
	$term->getattr(fileno($fh));
	my ($speed) = grep {/^\d+$/} @_; 
	$speed ||= 9600;
	my $baud;
	{
		no strict 'refs';
		$baud = &{'POSIX::B' . $speed};
	}
	$term->setispeed($baud);
	$term->setospeed($baud);

	my $cflag = $term->getcflag(); my $lflag = $term->getlflag();
	my $oflag = $term->getoflag(); my $iflag = $term->getiflag();

	# set raw
	########################################################################
	$iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
	$oflag &= ~OPOST;
	$lflag &= ~(ECHO|ECHONL|ICANON|ISIG);
	$cflag &= ~(CSIZE|PARENB|HUPCL);
	#########################################################################
	#

	$cflag |= CLOCAL|CREAD;
	$cflag |= (grep {/^cs7$/i} @_) ? CS7 : CS8;
	if (my ($parity) = grep {/^(odd|even)$/i} $@) {
		$cflag |= PARENB;
		$cflag |= PARODD if $parity =~ /odd/i; 
	}
	$cflag |= CRTSCTS if grep /rtscts$/, $@;
	$term->setcflag($cflag); $term->setlflag($lflag);
	$term->setoflag($oflag); $term->setiflag($iflag);
	$term->setattr(fileno($fh), TCSANOW);
	$self->{device} = $device;
	$self->{speed} = $speed;
	return $self;
}

sub getattr
{
	my $self = shift;
	$self->{TERM}->getattr(fileno($self->fh));
	return $self->{TERM};
}

sub setattr
{
	my $self = shift;
	my $attr = shift || $self->{TERM};
	$attr->setattr(fileno($self->fh), &POSIX::TCSANOW);
}

sub DESTROY
{
	my $self = shift;
	$self->setattr($self->{ORIGTERM});
}

1;
