view release on metacpan or  search on metacpan

lib/Device/SerialPort/Xmodem.pm~  view on Meta::CPAN

	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);
  }