view release on metacpan or  search on metacpan

lib/Device/IRU_GE.pm  view on Meta::CPAN

# --- Conversion factors ---
my  $LL_cnv = pi / 2**30; 
my  $HDG_cnv = (360/6400) / 100; 

# - - - - - - - - - - - - - - - -
sub new
{
  my $caller = shift @_;

  # In case someone wants to sub-class
  my $caller_is_obj  = ref($caller);
  my $class = $caller_is_obj || $caller;

  # Passing reference or hash
  my %arg_hsh;
  if ( ref($_[0]) eq "HASH" ) { %arg_hsh = %{ shift @_ } }
  else                        { %arg_hsh = @_ }

  my $port = $arg_hsh{'port'} || "COM3";
 
  my $port_obj = new Device::SerialPort ($port) || die "Can't open $port: $^E\n";
  #-#my $port_obj = new Win32::SerialPort ($port) || die "Can't open $port: $! $^E\n";

  my $baudrate = $arg_hsh{baudrate} || 19200;
 
  my $parity   = $arg_hsh{parity}   || "none";
  my $databits = $arg_hsh{databits} || 8;
  my $stopbits = $arg_hsh{stopbits} || 1;


  # After new, must check for failure
  $port_obj->baudrate($baudrate);
  $port_obj->parity($parity);
  $port_obj->databits($databits);
  $port_obj->stopbits($stopbits);

  #$port_obj->handshake('rts');

  if ( $^O =~ /MS/ )
  {
    $port_obj->read_interval(500);    # max time between read char (milliseconds)
    $port_obj->read_const_time(500);  # Functions as a timeout
  } 
 
  #-# $port_obj->read_interval(1);    # max time between read char (milliseconds) Not in Device::SerialPort 
   $port_obj->read_const_time(10000);  # total = (avg * bytes) + const THIS IS NECESSARY!!!!
    
  #$port_obj->handshake("rts");
  #$port_obj->buffers(4096, 4096);
 
  $port_obj->write_settings || undef $port_obj;

  unless ($port_obj) { die "Can't change Device_Control_Block: $^E\n"; }

  my ($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = $port_obj->status
      || warn "could not get port status\n";

  if ($BlockingFlags)
  {
     #warn "Port is blocked $BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags\n";
  }

  if ($BlockingFlags & BM_fCtsHold) { warn "Waiting for CTS"; }
  if ($LatchErrorFlags & CE_FRAME) { warn "Framing Error"; }

  $port_obj->purge_all();  # these don't seem to work but try anyway.
  $port_obj->purge_rx();

  # The object data structure
  my $self = bless {
                        'arg_hsh'         => { %arg_hsh },
                        'fh'              => $arg_hsh{fh},
                        'continuous_mode' => $arg_hsh{'continuous_mode'},
                        'port_obj'        => $port_obj,
                        'cmd'             => '',
                        'rsp'             => [],
                        'factor'          => { %factor }
                   }, $class;
  return $self;
}

#-----------------------------------------------------
# Test using serial plug
#-----------------------------------------------------
sub plug_test
{
  my $self = shift @_; 
  #my $cmd = shift @_; 

  my $cmd = "Round Trip Worked\n";
  
  my $cnt_out = $self->{'port_obj'}->write($cmd);
  unless ($cnt_out) { warn "write failed\n" };

  my $cmd_len = bytes::length($cmd);
  if ( $cnt_out != $cmd_len ) { die "write incomplete only wrote $cnt_out should have written $cmd_len\n"};

  sleep (1);  # Necessary?

  # ------ Send to unit ----- 
  my $length = length($cmd);
  my ($count_in, $str_read) = $self->{'port_obj'}->read($length);
  if ( $count_in == 0) { warn "Time out on read for $caller\n"; }

  #my $char_lst = join "", unpack("C*",$str_read);
  #print "$length ::: $count_in |$char_lst|$str_read|\n";

  return $str_read; 
}


#----------------------------------------------------------------------
sub get_test_sequence
{
  my $self = shift @_; 

  # Word 1: Header = 0009h
  # Word 2: Data word 1 to be echoed
  # Word 3: Data word 2 to be echoed
  # Word 4: Data word 3 to be echoed