use strict;
use warnings;
use Win32::SerialPort qw( :STAT 0.19 );
use FileHandle;

my ($WRITE, $DATAF);
open($WRITE, ">".$mfilePath . "capture_all.txt")       or die "Output 
+file path not found :$!";
open($DATAF, ">".$mfilePath . "channel_input.m")       or die "Output 
+file path not found :$!";
$DATAF->autoflush(1);
$WRITE->autoflush(1);
$LOG->autoflush(1);


my ($Baudrate, $DataBits, $StopBits, $Parity, $ReadInterval, $Buffers1
+, $Buffers2, $HandShake, $UserMsg, $ErrMsg );

$Baudrate        = 9600;
$DataBits        = 8;
$StopBits        = 1;
$Parity          = 'none';
$ReadInterval    = 0xffffffff;
$Buffers1        = 4096*2;
$Buffers2        = 4096*2;
$HandShake       = 'none';
$UserMsg         = 1;
$ErrMsg          = 1;


$obCpe = Win32::SerialPort->new ("COM1") || die "CO port not found :$!
+";

&configureComPort( $obCpe, $Baudrate, $DataBits, $StopBits, $Parity, $
+ReadInterval, $Buffers1, $Buffers2, $HandShake, $UserMsg, $ErrMsg);

&checkComPort( $obCpe );

$obCpe->write('-----something-----');  # write a command to the hardwa
+re I am talking to
&write_pd_data($obCpe, 'afile handle', 'another file handle'); # read 
+many lines which are output by the hardware

######################################################################
+##########################

sub write_pd_data {

        my $object = shift;
        my $WRITE = shift;   # a file where text emitted by hardware i
+s stored
        my $DATAF = shift;   # another file where some the text is sto
+red in some different format

        my $line;

        while(1){
                $line = &readline($object);
                print $line;
                print $WRITE $line;

                if($line =~ /cpe>/){
                        print $DATAF "];";
                        last;
                }
                else{
                        print $DATAF $line;
                }
        }

}

######################################################################
+##########################

sub readline  {

        my $buffer = '';
        my $b = '';
        my $count = 0;

        my $object = shift;

        while(1)
        {
                $b = $object->read(1);
                $buffer .= $b;
                if($b eq '') {
                        $count += 1;
                        if($count > 100) {
                                return($buffer);
                        }
                }

                if (($b eq "\r") or ($b eq "\n")) {
                        return($buffer);
                }
        }
}

######################################################################
+##########################

sub configureComPort {

        my $ComPort      = shift;

        my $Baudrate     = shift;
        my $DataBits     = shift;
        my $StopBits     = shift;
        my $Parity       = shift;
        my $ReadInterval = shift;
        my $Buffers1     = shift;
        my $Buffers2     = shift;
        my $HandShake    = shift;
        my $UserMsg      = shift;
        my $ErrMsg       = shift;


        $ComPort->baudrate($Baudrate);
        $ComPort->databits($DataBits);
        $ComPort->stopbits($StopBits);
        $ComPort->parity($Parity);
        $ComPort->read_interval($ReadInterval);    #read in unblocking
+ mode (don't wait for chars to come; return immediately)
        $ComPort->buffers($Buffers1, $Buffers2);                # read
+ / write buffers
        $ComPort->handshake($HandShake);
        $ComPort->user_msg($UserMsg);
        $ComPort->error_msg($ErrMsg);

        $ComPort->write_settings;
}

######################################################################
+##########################

sub checkComPort {

        # my $port = shift @_;
        my $port = shift;  # try without @_

        print "\nCurrent Settings for $port\n";
        print $WRITE "\nCurrent Settings for $port\n";

        my $Baudrate       =   $port->baudrate;
        my $DataBits       =   $port->databits;
        my $StopBits       =   $port->stopbits;
        my $Parity         =   $port->parity;
        my $ReadInterval   =   $port->read_interval;
        my @Buffers        =   $port->buffers;
        my $HandShake      =   $port->handshake;
        my $UserMsg        =   $port->user_msg;
        my $ErrMsg         =   $port->error_msg;

        print "\nBaudrate =$Baudrate; \nDataBits = $DataBits; \nStopBi
+ts = $StopBits; \nParity = $Parity; \nReadInterval = $ReadInterval; \
+nReadWriteBuffers = @Buffers; \nHandShake = $HandShake; \nUser_Msg = 
+$UserMsg; \nErrMsg = $ErrMsg;";

}
[download]