Temperature controller hasg3, TCU200

The following virtual motor operates a temperature controller via USB. This is the VM code:

#!/usr/bin/perl -w
#
# file name: /online_dir/vm1.pl
#
# This script is a template for a virtual motor. 
# 
my ($method, $value_new) = @ARGV; 

my $status = 1; 

if( $method eq "set_position")
{
    Spectra::set_temp_tcu200( $value_new); 
}
elsif( $method eq "get_position")
{
    $SYM{RETURN_VALUE} = Spectra::get_temp_tcu200(1);
}
elsif( $method eq "get_limit_min")
{
    $SYM{RETURN_VALUE} = 0.;
}
elsif( $method eq "get_limit_max")
{
    $SYM{RETURN_VALUE} = 1000;
}
elsif( $method eq "exec_stop")
{
    ;
}
else
{
    Spectra::error( "vm1: failed to identify $method"); 
    $status = 0;
    goto finish;
}
finish:
 $status;

The functions that speak to the device are defined in /online_dir/TkIrc.pl:

#
#
#
package Spectra; 

use strict; 
use Fcntl; 
use POSIX qw( :termios_h); 
my $flag_tcu200_open = 0; 
my $flag_tcu200_debug = 0; 

sub open_tcu200
{
    my $status = 1; 
    my $dev = "/dev/ttyUSB0"; 

#
# the configuration
#
#$ stty -F /dev/ttyUSB0  -a
# speed 9600 baud; rows 0; columns 0; line = 0;
# intr = ^C; quit = ^\; erase = ^?; kill = ^U; eof = ^D; eol = <undef>; eol2 = <undef>; swtch = <undef>; start = ^Q; stop = ^S;
# susp = ^Z; rprnt = ^R; werase = ^W; lnext = ^V; flush = ^O; min = 0; time = 0;
# parenb -parodd cs7 hupcl -cstopb cread clocal -crtscts
# -ignbrk brkint ignpar -parmrk -inpck -istrip -inlcr -igncr -icrnl -ixon -ixoff -iuclc -ixany imaxbel iutf8
# -opost -olcuc -ocrnl onlcr -onocr -onlret -ofill -ofdel nl0 cr0 tab0 bs0 vt0 ff0
# -isig -icanon -iexten -echo -echoe -echok -echonl -noflsh -xcase -tostop -echoprt -echoctl -echoke

    if( -e $dev)
    {
	    system( "stty -F $dev 7fffe006:4:dad:0:3:1c:7f:15:4:0:0:0:11:13:1a:0:12:f:17:16:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0"); 
    }
    else
    {
	    $dev = "/dev/ttyUSB1"; 
	    if( -e $dev)
	    {
	  	    system( "stty -F $dev 7fffe006:4:dad:0:3:1c:7f:15:4:0:0:0:11:13:1a:0:12:f:17:16:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0"); 
	    }
	    else
	    {
	  	    print " no USB device \n"; 
		    goto finish;
	    }
    }

    if( !sysopen(USB, $dev, O_RDWR))
    {
  	  if( !sysopen(USB, $dev, O_RDWR))
	  {
	    Spectra::error(" open_tcu200: failed to open USB0 and USB1 "); 
	    $status = 0; 
	    goto finish;
	  }
    }
finish:
    return $status;
}

sub recv_tcu200
{
    my ( $tmo) = @_; 
    my $status = undef; 
    my $flag_retry = 0;

    if( !$flag_tcu200_open)
    {
	  open_tcu200(); 
	  if( !$flag_tcu200_open)
	  {
	    Spectra::error( "Failed to open USB for Tcu200 controller"); 
	    goto finish;
	  }
    }

retry:
    my $rin = my $win = my $ein = ""; 
    vec( $rin, fileno( USB), 1) = 1; 
    $ein = $rin | $win;
    #
    # do we have input?
    #
    my $nfd = select( $rin, $win, $ein, $tmo); 
    if( !$nfd)
    {
	  Spectra::error( "TkIrc::recv_tcu200: time-out during select(), tmp $tmo"); 
	  $status = undef;
	  goto finish;
    }

    my $buffer = " " x 101; 
    sysread( USB, $buffer, 100, 0);

    $buffer = substr( $buffer, 3); 
    $buffer = substr( $buffer, 0, length( $buffer) - 2); 
    if( length( $buffer) < 1)	
    {
	  if( !$flag_retry)
	  {
	    $flag_retry = 1;
	    if( $flag_tcu200_debug)
	    {
		  print "recv_tcu200: received empty answer, repeating recv()\n"; 
	    }
	    goto retry;
	  }
	  else
	  {
	    Spectra::error(" TkIRc.pl::recv_tcu200: received 2nd empty answer");
	    $status = undef;
	    goto finish;
	  }
    }

    $status = $buffer; 

    if( $flag_tcu200_debug)
    {
	  print "recv_tcu200: <<< $status"; 
    }
    
 finish:
    return $status; 
}

sub send_tcu200
{
    my ($buffer_in) = @_; 
    my $status = 1; 

    if( !$flag_tcu200_open)
    {
	  open_tcu200(); 
	  if( !$flag_tcu200_open)
	  {
	    Spectra::error( "Failed to open usb for Tcu200 controller"); 
	    $status = 0;
	    goto finish;
	  }
    }

    syswrite( USB, $buffer_in, length($buffer_in), 0);     

    if( $flag_tcu200_debug)
    {
	  print "send_tcu200: >>> $buffer_in\n"; 
    }
    

finish:
    return $status;
}

sub set_temp_tcu200
{
    my ( $setpoint) = @_; 

    my $status = 1;
    my $part1 = "\0040011\002"; 
    my $part2 = sprintf( "SL%.1f\003", $setpoint); 
    my @l = unpack("C*", $part2);
    my $bcc = $l[0];
    for( my $i = 1; $i < length( $part2); $i++)
    {
	  $bcc = $bcc ^ $l[$i];
    }

    my $buffer_out = $part1 . $part2 . chr($bcc) . "\r\n"; 

    if( !send_tcu200( $buffer_out))
    {
	  Spectra::error( "TkIrc::set_temp_tcu200: failed to seg 'temp'"); 
	  $status = 0; 
	  goto finish;
    }
    select undef, undef, undef, 0.05;

    if( $flag_tcu200_debug)
    {
	  print "send_tcu200: <<< $setpoint\n"; 
    }

 finish:
    return $status;
}	
sub get_temp_tcu200
{
    my $status = 1;

    my $buffer = "\0040011PV\005\r\n"; 

    if( !send_tcu200( $buffer))
    {
	  Spectra::error( "TkIrc::get_temp_tcu200: failed to get 'temp'"); 
	  $status = 0; 
	  goto finish;
    }
    #
    # 2 seconds time-out
    #
    select undef, undef, undef, 0.05;
    my $buffer = recv_tcu200( 2); 
    if( !defined( $buffer))
    {
	  $status = Spectra::error( "TkIRc::get_temp_tcu200: failed to receive temp"); 
	  goto finish;	  
    }
    #
    # remove a leading 'V' which comes when a new temperatur is sent
    #
    $buffer =~ s/^V(.+)$/$1/; 
 finish:
    return $buffer;
}