#
# Module to do serial handling on perl FileHandles
#

use strict;

package DWeather::Serial;

use POSIX qw(:termios_h);
use Fcntl;

our @ISA = qw(IO::File);


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

sub new
{
	my $pkg = shift;
	my $class = ref $pkg || $pkg;
	my $device = shift || "/dev/ttyS0";

	my $self = $pkg->SUPER::new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;

	# get my attributes
	$$self->{ORIGTERM} = POSIX::Termios->new();
	my $term =  $$self->{TERM} = POSIX::Termios->new();
	$$self->{ORIGTERM}->getattr(fileno($self));
	$term->getattr(fileno($self));
	my ($speed) = grep {/^\d+$/} @_; 
	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($self), TCSANOW);
	return $self;
}

sub getattr
{
	my $self = shift;
	$$self->{TERM}->getattr;
	return $$self->{TERM};
}

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

sub close
{
	my $self = shift;
	$self->setattr($$self->{ORIGTERM});
	$self->SUPER::close;
}

sub DESTROY
{
	my $self = shift;
	$self->close;
}

1;
