#!/usr/bin/perl
require 5.003;
use English;
use strict;
use Win32::SerialPort qw(:PARAM :STAT );
use Win32API::CommPort qw( :RAW :PARAM :STAT 0.20 );

$OUTPUT_AUTOFLUSH=1;

my $BlockingFlags;
my $buffer;
my $Configuration_File_Name='c:\\temp\\tty-conf.txt';
my $count_in;
my $count_out;
my $flowcontrol;
my $InBytes;
my $LatchErrorFlags;
my $OutBytes;
my $quiet=1;
my $PortObj;
my $string_in;

$PortObj = new Win32::SerialPort ('COM3', $quiet)|| die "Can't open COM Port: $^E\n";    # $quiet is optional

$buffer = $PortObj->can_rlsd_config;
print("RLSD_CONF: >$buffer<\n");

$PortObj->baudrate(9600);
$PortObj->parity("none");
$PortObj->databits(8);
$PortObj->stopbits(1);
$PortObj->handshake("none");           # set parameter
$PortObj->dtr_active(1);          
$PortObj->buffers(4096, 4096);  # read, write
$PortObj->read_interval(100);    # max time between read char (milliseconds)
$PortObj->read_char_time(5);     # avg time between read char
$PortObj->read_const_time(100);  # total = (avg * bytes) + const
$PortObj->write_char_time(5);
$PortObj->write_const_time(100);
$PortObj->debug(1);
$PortObj->stty("-icanon");    # disable eof, erase and kill char, Unix-style
$PortObj->write_settings||undef($PortObj);
$PortObj->save($Configuration_File_Name);

$flowcontrol = $PortObj->handshake;    # current value (scalar)
print("HS: >$flowcontrol<\n");

($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = $PortObj->status|| warn "could not get port status\n";
print("BF: >$BlockingFlags<\n");
warn "Port is blocked" if ($BlockingFlags!=0);
if ($BlockingFlags & BM_fXoffHold) { warn "Waiting for Xoff"; }
if ($BlockingFlags & BM_fDsrHold) { warn "Waiting for DSR"; }
if ($BlockingFlags & BM_fRlsdHold) { warn "Waiting for Rlsd"; }
if ($BlockingFlags & BM_fCtsHold) { warn "Waiting for CTS"; }
if ($LatchErrorFlags & CE_FRAME) { warn "Framing Error"; }

$buffer=ClearCommError($PortObj, 65535, 0);

$count_out = $PortObj->write('TEST');
warn "write failed\n"         unless ($count_out);
warn "write incomplete\n"     if ( $count_out != 4 );

# Bridging TXD and RXD should put 'TEST' into the reveive buffer
($count_in, $string_in) = $PortObj->read($count_out);
warn "read unsuccessful\n" unless ($count_in == $count_out);
print("RX: >$string_in<\n");
undef $PortObj;

exit;

##</code><code>##

RLSD_CONF: >64<
HS: >none<
Blocking Bits= 0
Input Queue= 0
Output Queue= 0
Latched Errors= 0
ok= 1
BlockingFlags= 0
Error_BitMask= 0
BF: >4<
RX: ><
Destroying \\.\COM3
Port is blocked at P:/tools/perl/test-serial-monk.pl line 50.
Waiting for Rlsd at P:/tools/perl/test-serial-monk.pl line 53.
write failed
write incomplete
Use of uninitialized value $wanted in numeric gt (>) at C:/progs/Perl64/site/lib/Win32/SerialPort.pm line 1212.
Closing Win32::SerialPort=HASH(0x60c580) COM3 at P:/tools/perl/test-serial-monk.pl line 66.