The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.004;
use strict;
use warnings;

our $VERSION = '1.03';

# Preloaded methods go here.

package Device::SerialPort::Xmodem::Constants;

# Define constants used in xmodem blocks
sub nul        () { 0x00 } # ^@
sub soh        () { 0x01 } # ^A
sub stx        () { 0x02 } # ^B
sub eot        () { 0x04 } # ^D
sub ack        () { 0x06 } # ^E
sub nak        () { 0x15 } # ^U
sub can        () { 0x18 } # ^X
sub C          () { 0x43 }
sub ctrl_z     () { 0x1A } # ^Z

sub CHECKSUM   () { 1 }
sub CRC16      () { 2 }
sub CRC32      () { 3 }

sub XMODEM     () { 0x01 }
sub XMODEM_1K  () { 0x02 }
sub XMODEM_CRC () { 0x03 }
#sub YMODEM     () { 0x04 }
#sub ZMODEM     () { 0x05 }

package Device::SerialPort::Xmodem::Block;

use overload q[""] => \&to_string;

# Create a new block object
sub new {
	my($proto, $num, $data, $length) = @_;
	my $class = ref $proto || $proto;

	# Check is block had required number of parameters
  if (@_ < 3) {
    # Return 0 length block
    $length = 0;
  } else {
  	# Define block type (128 or 1k chars) if not specified
	  $length ||= ( length $data > 128 ? 1024 : 128 );
  }

	# Define structure of a Xmodem transfer block object
	my $self = {
		number  => defined $num ? $num : 0,
		'length'=> $length,
		data    => defined $data ? substr($data, 0, $length) : "",      # Blocks are limited to 128 or 1024 chars
	};

	bless $self, $class;
}

# Calculate checksum of current block data
sub checksum {
	my $self = $_[0];
	my $sum  = 0;
	foreach my $c ( $self->data() ) {
		$sum += ord $c;
    $sum %= 256;
	}
	return $sum % 256;
}

# Calculate CRC 16 bit on block data
sub crc16 {
	my $self = $_[0];
	return unpack('%C16*' => $self->data()) % 65536;
}

# Calculate CRC 32 bit on block data
sub crc32 {
	my $self = $_[0];
	return unpack('%C32' => $self->data());
}

# Return data one char at a time
sub data {
	my $self = $_[0];
	return wantarray
		? split(//, $self->{data})
		: substr($self->{data}, 0, $self->{'length'})
}

sub number {
	my $self = $_[0];
	return $self->{number};
}

# Calculate checksum/crc for the current block and stringify block for transfer
sub to_string {
	my $self = $_[0];
	my $block_num = $self->number();

	# Assemble block to be transferred
	my $xfer = pack(

    'cccA128c',
  
		Device::SerialPort::Xmodem::Constants::soh,

		$block_num,                    # Block number

		$block_num ^ 0xFF,             # 2's complement of block number

		scalar $self->data,            # Data chars

		$self->checksum()              # Final checksum (or crc16 or crc32)
	);

	return $xfer;
}

#
# verify( type, value )
# ex.: verify( 'checksum', 0x7F )
# ex.: verify( 'crc16', 0x8328 )
#
sub verify {
	my($self, $type, $value) = @_;
  my $good_value;
	# Detect type of value to be checked

	# TODO use new constants

	$type = 'checksum' unless defined $type;

	if( $type eq 'checksum' ) {
		$good_value = $self->checksum();
	} elsif( $type eq 'crc16' ) {
		$good_value = $self->crc16();
	} elsif( $type eq 'crc32' ) {
		$good_value = $self->crc32();
	} else {
		$good_value = $self->checksum();
	}
	return $good_value == $value;
}

# ----------------------------------------------------------------

package Device::SerialPort::Xmodem::Buffer;

sub new {
	my($proto, $num, $data) = @_;
	my $class = ref $proto || $proto;

	# Define structure of a Xmodem transfer buffer
	my $self = [];
	bless($self);
	return $self;
}

# Push, pop, operations on buffer
sub push {
	my $self  = $_[0];
	my $block = $_[1];
	push @$self, $block;
}

sub pop {
	my $self = $_[0];
	pop @$self
}

# Get last block on buffer (to retransmit / re-receive)
sub last {
	my $self = $_[0];
	return $self->[ $#$self ];
}

sub blocks {
	return @{$_[0]};
}

#
# Replace n-block with given block object
#
sub replace {
	my $self  = $_[0];
	my $num   = $_[1];
	my $block = $_[2];

	$self->[$num] = $block;
}

sub dump {
  my $self = $_[0];
  my $output;
  
  # Join all blocks into string
  for (my $pos = 0; $pos < scalar($self->blocks()); $pos++) {
    $output .= $self->[$pos]->data();
  }
  
  # Clean out any end of file markers (^Z) in data
  $output =~ s/\x1A*$//;
  
  return $output;
}

# ----------------------------------------------------------------

package Device::SerialPort::Xmodem::Send;

use Fcntl qw(:DEFAULT :flock);

# Define default timeouts for CRC handshaking stage and checksum normal procedure
sub TIMEOUT_CRC      () {  3 };
sub TIMEOUT_CHECKSUM () { 10 };

our $TIMEOUT = TIMEOUT_CRC;
our $DEBUG   = 0;

sub new {
	my $proto = shift;
	my %opt   = @_;
	my $class = ref $proto || $proto;

	# If port does not exist fail
	_log('port = ', $opt{port});
	if( ! exists $opt{port} ) {
    _log('No valid port given, giving up.');
    return 0;
	}

	my $self = {
		_port    => $opt{port},
		_filename => $opt{filename},
		current_block => 0,
		timeouts  => 0,
	};

	bless $self, $class;
}

sub start {
	my $self  = $_[0];
	my $port = $self->{_port};
	my $file  = $_[1] || $self->{_filename};
	my $protocol = $_[2] || Device::SerialPort::Xmodem::Constants::XMODEM();

	_log('[start] checking modem[', $port, '] or file[', $file, '] members');
	return 0 unless $port and $file;

	# Initialize transfer
	$self->{current_block} = 0;
	$self->{timeouts}      = 0;
	$self->{aborted}       = 0;
	$self->{complete}      = 0;

	# Initialize a receiving buffer
	_log('[start] creating new receive buffer');

	my $buffer = Device::SerialPort::Xmodem::Buffer->new();

	$self->{current_block} = Device::SerialPort::Xmodem::Block->new(0);

  # Attempt to handshake
	return undef unless $self->handshake();
	
  # Open input file
	my $fstatus_open = open(INFILE, '<' . $file);
  
  # If file does not open die gracefully
  if (!$fstatus_open) {
    _log('Error: cannot open file for reading, aborting transfer.\n');
    $self->abort_transfer();
    return undef;
  }
  
  # Get file lock
  my $fstatus_lock = flock(INFILE, LOCK_SH);

  # If file does not lock complain but carry on
  if (!$fstatus_lock) {
    _log('Warning: file could not be locked, proceeding anyhow.\n');
  }

  # Create first block
  my $block_data = undef;
  seek(INFILE, 0, 0);
  read(INFILE, $block_data, 128, 0);
  _log('[start] creating first data block [', unpack('H*',$block_data), '] data');
  $self->{current_block} = Device::SerialPort::Xmodem::Block->new(0x01, $block_data);
  
	# Main send cycle (subsequent timeout cycles)
	do {
    
    _log('doing loop\n');
    
    $self->send_message($self->{current_block}->to_string());
    
    my %message = $self->receive_message();
    
    if ( $message{type} eq Device::SerialPort::Xmodem::Constants::ack() ) {
      # Received Ack, if more file remains send more
      _log('[start] received <ack>: ', $message{type}, ', sending preparing next block.\n');
      _log('building new block at ', ($self->{current_block}->number() * 128), ', 128 long.\n');
      seek(INFILE, ($self->{current_block}->number() * 128), 0);
      my $block_data = undef;
      my $bytes_read = read(INFILE, $block_data, 128, 0);
      if ($bytes_read != 0) {
        # Not EOT create next block
        _log('blocks read: ', $bytes_read, ', total length: ', length($block_data), '.\n');
        while (length($block_data) < 128) {
          _log('padding block_data');
          $block_data .= chr(0x1a);
        }
        _log('blocks read: ', $bytes_read, ', total length: ', length($block_data), '.\n');
        _log('[start] creating new data block [', unpack('H*',$block_data), '] data');
        _log('creating as block no ', ($self->{current_block}->number() + 1), '.\n');
        $self->{current_block} = Device::SerialPort::Xmodem::Block->new( ($self->{current_block}->number() + 1), $block_data);
        $self->{timeouts} = 0;
      } else {
        # Send EOT, we've hit the end!
        $self->send_eot();
        $self->{complete} = 1;
      }
		} else {
      # If last block transmitted mark complete and write file
      _log('[start] <nak> or assumed (garble): ', $message{type}, ', trying again.\n');
      $self->{timeouts}++;
		}
    
	} until (($self->{complete}) || ($self->timeouts() >= 10) || ($self->{aborted}));

  if ($self->{complete}) {
    do {
      my %message = $self->receive_message();
      if ( $message{type} eq Device::SerialPort::Xmodem::Constants::ack() ) {
        return 1;
      } else {
        $self->{timeouts}++;
      }
    } until ($self->timeouts() >= 10);
  }
  
  if ($self->timeouts() >= 10) {
    _log('Too many errors, giving up.\n');
    $self->abort_transfer();
    return undef;
  }
}

sub receive_message {
	my $self = $_[0];
	my $message_type;
  my $count_in = 0;
  my $received;
  my $done = 0;
  my $error = 0;
  
  my $receive_start_time = time;
	# Receive answer
  do {
    my $count_in_tmp = 0;
    my $received_tmp;
    ($count_in_tmp, $received_tmp) = $self->port->read(1);
    $received .= $received_tmp;
    $count_in += $count_in_tmp;
    if ($count_in > 0) {
      # short message, this is all the sender should receive
      $done = 1;
    } elsif (time > $receive_start_time + 2) {
      # wait for timeout, give the message at least a second
      $error = 1;
    }
  } while(!$done && !$error);
  
  if ($error) {
    _log('timeout receiving message');
  }
  
	_log('[receive_message][', $count_in, '] received [', unpack('H*',$received), '] data');

  # Get Message Type
  $message_type = ord(substr($received, 0, 1));
  
  my %message = (
    type       => $message_type,        # Message Type
  );
  
	return %message;
}

sub handshake {
	my $self = $_[0];
  my $count_in = 0;
  my $received;
  my $done = 0;
  my $error = 0;
  
  my $receive_start_time = time;
	# Receive answer
  do {
    my $count_in_tmp = 0;
    my $received_tmp;
    ($count_in_tmp, $received_tmp) = $self->port->read(1);
    $received .= $received_tmp;
    $count_in += $count_in_tmp;
    if ($count_in > 0) {
      # short message, this is all the sender should receive
      $done = 1;
    } elsif (time > $receive_start_time + 11) {
      # wait for timeout, give the message at least ten seconds
      $error = 1;
    }
  } while(!$done && !$error);
  
  if ($error) {
    _log('timeout waiting for handshake');
    return 0;
  }
  
	_log('[handshake][', $count_in, '] received [', unpack('H*',$received), '] data');

  # Get Message Type
  if (ord(substr($received, 0, 1)) eq Device::SerialPort::Xmodem::Constants::nak()) {
    _log('[hand shake] success');
    return 1;
  } else {
    _log('[hand shake] failure');
    return 0;
  }
}

sub send_message {
  # This function sends a raw data message to the open port.
	my $self = $_[0];
  my $message = $_[1];
	_log('[send_message] received [', unpack('H*',$message), '] data');
	$self->port->write($message);
	$self->port->write_drain();
	return 1;
}

sub send_eot {
	# Send EOT character
	my $self = $_[0];
	_log('sending <EOT>');
	$self->port->write( chr(Device::SerialPort::Xmodem::Constants::eot()) );
	$self->port->write_drain();
	return 1;
}

sub abort_transfer {
	# Send a cancel char to abort transfer
	my $self = $_[0];
	_log('aborting transfer');
	$self->port->write( chr(Device::SerialPort::Xmodem::Constants::can()) );
	$self->port->write_drain();
	$self->{aborted} = 1;
	return 1;
}

sub timeouts {
	my $self = $_[0];
	$self->{timeouts};
}

# Get `port' Device::SerialPort member
sub port {
	$_[0]->{_port};
}

sub _log {
	print STDERR @_, "\n" if $DEBUG
}

# ----------------------------------------------------------------

package Device::SerialPort::Xmodem::Receive;

# Define default timeouts for CRC handshaking stage and checksum normal procedure
sub TIMEOUT_CRC      () {  3 };
sub TIMEOUT_CHECKSUM () { 10 };

our $TIMEOUT = TIMEOUT_CRC;
our $DEBUG   = 0;

sub new {
	my $proto = shift;
	my %opt   = @_;
	my $class = ref $proto || $proto;

	# If port does not exist fail
	_log('port = ', $opt{port});
	if( ! exists $opt{port} ) {
    _log('No valid port given, giving up.');
    return 0;
	}

	my $self = {
		_port    => $opt{port},
		_filename => $opt{filename} || 'received.dat',
		current_block => 0,
		timeouts  => 0,
	};

	bless $self, $class;
}

sub start {
	my $self  = $_[0];
	my $port = $self->{_port};
	my $file  = $_[1] || $self->{_filename};
	my $protocol = $_[2] || Device::SerialPort::Xmodem::Constants::XMODEM();

	_log('[start] checking modem[', $port, '] or file[', $file, '] members');
	return 0 unless $port and $file;

	# Initialize transfer
	$self->{current_block} = 0;
	$self->{timeouts}      = 0;
	$self->{aborted}       = 0;
	$self->{complete}       = 0;

	# Initialize a receiving buffer
	_log('[start] creating new receive buffer');

	my $buffer = Device::SerialPort::Xmodem::Buffer->new();

	# Stage 1: handshaking for xmodem standard version 
	_log('[start] sending first timeout');
	$self->send_nak();

	$self->{current_block} = Device::SerialPort::Xmodem::Block->new(0);

	# Open output file
	my $fstatus_open = open OUTFILE, '>'.$file;

  # If file does not open die gracefully
  if (!$fstatus_open) {
    _log('Error: cannot open file for writing, aborting transfer.\n');
    $self->abort_transfer();
    return undef;
  }
  
	# Main receive cycle (subsequent timeout cycles)
	do {

		# Try to receive a message
		my %message = $self->receive_message();
    
    if ( $message{type} eq Device::SerialPort::Xmodem::Constants::nul() ) {
      # Nothing received yet, do nothing
      _log('[start] <NUL>', $message{type});
		} elsif ( $message{type} eq Device::SerialPort::Xmodem::Constants::eot() ) {
      # If last block transmitted mark complete and write file
      _log('[start] <EOT>', $message{type});

      # Acknoledge we received <EOT>
      $self->send_ack();
	    $self->{complete} = 1;
      
      # Write buffer data to file
      print(OUTFILE $buffer->dump());
      
	    close OUTFILE;
		} elsif ( $message{type} eq Device::SerialPort::Xmodem::Constants::soh() ) {
      # If message header, check integrity and build block
      _log('[start] <SOH>', $message{type});
      my $message_status = 1;
      
      # Check block number
      if ( (255 - $message{complement}) != $message{number} ) {
        _log('[start] bad block number: ', $message{number}, ' != (255 - ', $message{complement}, ')' );
        $message_status = 0;
      }
      
      # Check block numbers for out of sequence blocks
      if (
           (
             (
               ($message{number} < $self->{current_block}->number())
               || ($message{number} > ($self->{current_block}->number() + 1))
             )
             && ($message{number} != 0x00)
           )
           || (
             (
               ($self->{current_block}->number() != 0xFF)
             )
             && ($message{number} == 0x00)
           )
         ) {
        _log('[start] bad block sequence');
        $self->abort_transfer();
      }

      # Instance a new "block" object from message data received
      my $new_block = Device::SerialPort::Xmodem::Block->new( $message{number}, $message{data} );

      # Check block against checksum
      if (!( defined $new_block && $new_block->verify( 'checksum', $message{checksum}) )) {
        _log('[start] bad block checksum');
        $message_status = 0;
			}
      
      # This message block was good, update current_block and push onto buffer
      if ($message_status) {
        _log('[start] received block ', $new_block->number());

        # Update current block to the one received
        $self->{current_block} = $new_block;
        
        # Push block onto buffer
        $buffer->push($self->{current_block});
        
        # Acknoledge we successfully received block
        $self->send_ack();
        
      } else {
        # Send nak since did not receive block successfully
        _log('[start] message_status = 0, sending <NAK>');
        $self->send_nak();
      }
    } else {
      _log('[start] neither types found, sending timingout');
      $self->send_nak();
    }
		
	} until (($self->{complete}) || ($self->timeouts() >= 10) || ($self->{aborted}));
  
  if ($self->timeouts() >= 10) {
    _log('Too many errors, giving up.\n');
    $self->abort_transfer();
    return undef;
  }
  
  return 1;
}

sub receive_message {
	my $self = $_[0];
	my $message_type;
	my $message_number = 0;
	my $message_complement = 0;
	my $message_data;
	my $message_checksum;
  my $count_in = 0;
  my $received;
  my $done = 0;
  my $error = 0;
  
  my $receive_start_time = time;
  
	# Receive answer
  do {
    my $count_in_tmp = 0;
    my $received_tmp;
    ($count_in_tmp, $received_tmp) = $self->port->read(132);
    $received .= $received_tmp;
    $count_in += $count_in_tmp;
    if ((ord(substr($received, 0, 1)) != 1) && ($count_in > 0)) {
      # this is a short message
      $done = 1;
    } elsif ($count_in >= 132) {
      # this is a block
      $done = 1;
    } elsif (time > $receive_start_time + 2) {
      # wait for timeout, give the message at least a second
      $error = 1;
    }
  } while(!$done && !$error);
  
  if ($error) {
    _log('timeout receiving message');
  }
  
	_log('[receive_message][', $count_in, '] received [', unpack('H*',$received), '] data');

  # Get Message Type
  $message_type = ord(substr($received, 0, 1));
  
	# If this is a block extract data from message
	if( $message_type eq Device::SerialPort::Xmodem::Constants::soh()   ) {
    
    # Check block number and its 2's complement
    ($message_number, $message_complement) = ( ord(substr($received,1,1)), ord(substr($received,2,1)) );

    # Extract data string from message
    $message_data = substr($received,3,128);
    
    # Extract checksum from message
    $message_checksum = ord(substr($received, 131, 1));    
  }
  
  my %message = (
    type       => $message_type,        # Message Type
    number     => $message_number,      # Message Sequence Number
    complement => $message_complement,  # Message Number's Complement
    data       => $message_data,        # Message Data String
    checksum   => $message_checksum,    # Message Data Checksum
  );
  
	return %message;
}

sub abort_transfer {
	my $self = $_[0];
	# Send a cancel char to abort transfer
	_log('aborting transfer');
	$self->port->write( chr(Device::SerialPort::Xmodem::Constants::can()) );
	$self->port->write_drain();
	$self->{aborted} = 1;
	return 1;
}

sub send_ack {
	my $self = $_[0];
	_log('sending ack');
	$self->port->write( chr(Device::SerialPort::Xmodem::Constants::ack()) );
	$self->port->write_drain();
	$self->{timeouts} = 0;
	return 1;
}

sub send_nak {
	my $self = $_[0];
	_log('sending timeout (', $self->{timeouts}, ')');
	$self->port->write( chr(Device::SerialPort::Xmodem::Constants::nak()) );
	$self->port->write_drain();
	$self->{timeouts}++;
	return 1;
}

sub timeouts {
	my $self = $_[0];
	$self->{timeouts};
}

# Get `port' Device::SerialPort member
sub port {
	$_[0]->{_port};
}

sub _log {
	print STDERR @_, "\n" if $DEBUG
}

1;
__END__

=head1 NAME

Device::SerialPort::Xmodem - Xmodem file transfer protocol for Device::SerialPort

=head1 SYNOPSIS

  use Device::SerialPort::Xmodem;

=head1 DESCRIPTION

This is an Xmodem implementation designed to receive a file using 128
byte blocks. This module is intended to be passed an open and prepared
port with active connection.

At this time it can only receive 128 byte blocks, however 1k blocks are
in the works. I do plan to write a send functionality soon.

=head1 Device::SerialPort::Xmodem::Constants

=head2 Synopsis

This is a set of contants that return hex values for the following:

 nul     ^@    0x00    null
 soh     ^A    0x01    start of header 128 byte block
 stx     ^B    0x02    start of header 1k byte block
 eot     ^D    0x04    end of trasmission
 ack     ^E    0x06    acknowlegded
 nak     ^U    0x15    not acknowledged
 can     ^X    0x18    cancel
 C             0x43    C ASCII char
 ctrl_z  ^Z    0x1A    end of file marker

 
=head1 Xmodem::Block

Class that represents a single Xmodem data block.

=head2 Synopsis

	my $b = Xmodem::Block->new( 1, 'My Data...<until-128-chars>...' );
	if( defined $b ) {
		# Ok, block instanced, verify its checksum
		if( $b->verify( 'checksum', <my_chksum> ) ) {
			...
		} else {
			...
		}
	} else {
		# No block
	}

	# Calculate checksum, crc16, 32, ...
	$crc16 = $b->crc16();
	$crc32 = $b->crc32();
	$chksm = $b->checksum();
  
  $b->to_string(); # outputs a formated message block

=head1 Xmodem::Buffer

Class that implements an Xmodem receive buffer of data blocks. Every block of data
is represented by a Device::SerialPort::Xmodem::Block object.

Blocks can be pushed and popped from the buffer. You can retrieve the last
block, or the list of blocks from buffer.

=head2 Synopsis

	my $buf = Xmodem::Buffer->new();
	my $b1  = Xmodem::Block->new(1, 'Data...');

	$buf->push($b1);

	my $b2  = Xmodem::Block->new(2, 'More data...');
	$buf->push($b2);

	my $last_block = $buf->last();

	print 'now I have ', scalar($buf->blocks()), ' in the buffer';
  
  print OUTFILE $buf->dump(); # outputs all data of all blocks in order

=head1 Device::SerialPort::Xmodem::Send

Control class to initiate and complete a X-modem file transfer in receive mode.

=head2 Synopsis

	my $send = Device::SerialPort::Xmodem::Send->new(
 		port     => {Device::SerialPort object},
		filename => 'name of file'
	);

	$send->start();

=head2 Object methods

=over 4

=item new()

Creates a new Device::SerialPort::Xmodem::Send object.

=item start()

Starts a new transfer until file send is complete. The only parameter accepted
is the local filename to be written. This quits if ten timeouts are received per block. 

=item receive_message()

Retreives a message, being an Xmodem command type (such as ack, nak, etc).

=item handshake()

If a <nak> message is received within 10 seconds returns true. 

=item send_message()

Sends a raw data message. This is typically a message block <soh> created by the
block to_string() function.

=item send_eot()

Sends a <eot> char, this signals to receiver that the file transfer is complete.

=item abort_transfer()

Sends a cancel <can> char, that signals to receiver that transfer is aborted.

=item timeouts()

Returns the number of timeouts that have occured, typically this is per message block.

=item port()

Returns the underlying L<Device::Serial> object.

=back

=head1 Device::SerialPort::Xmodem::Receive

Control class to initiate and complete a X-modem file transfer in receive mode.

=head2 Synopsis

	my $receive = Device::SerialPort::Xmodem::Receive->new(
 		port     => {Device::SerialPort object},
		filename => 'name of file'
	);

	$receive->start();

=head2 Object methods

=over 4

=item new()

Creates a new Device::SerialPort::Xmodem::Receive object.

=item start()

Starts a new transfer until file receive is complete. The only parameter accepted
is the (optional, default is received.dat) local filename to be written. This quits if ten timeouts are received. 

=item receive_message()

Retreives a message, either being an Xmodem command type (such as ack, nak, etc), or
a complete block (soh, blockno, blockno complement, data, checksum).

=item abort_transfer()

Sends a cancel <can> char, that signals to sender that transfer is aborted.

=item send_ack()

Sends an acknowledge <ack> char, to signal that we received and stored a correct block.
This also resets the count of timeouts.

=item send_nak()

Sends a <nak> char, to signal that we received a bad block header (either
a bad start char or a bad block number), or a bad data checksum. Increments count
of timeouts.

This also acts as a handshake.

=item timeouts()

Returns the number of timeouts that have occured, typically this is per message block.

=item port()

Returns the underlying L<Device::Serial> object.

=back

=head1 SEE ALSO

Device::SerialPort

Device::Modem::Protocol::Xmodem

=head1 AUTHORS

 Based on Device::Modem::Protocol::Xmodem, version 1.44, by Cosimo Streppone, E<lt>cosimo@cpan.orgE<gt>.
 Ported to Device::SerialPort by Aaron Mitti, E<lt>mitti@cpan.orgE<gt>. 

=head1 COPYRIGHT AND LICENCE

 Copyright (C) 2002-2004 Cosimo Streppone, E<lt>cosimo@cpan.orgE<gt>
 Copyright (C) 2005 by Aaron Mitti, E<lt>mitti@cpan.orgE<gt> 

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.


=cut