pdeshpan has asked for the wisdom of the Perl Monks concerning the following question:

Hello, I am using Win32::SerialPort qw( :STAT 0.19 ) module to communicate with a DSL modem over a serial port. The perl programme reads huge amount of data from the modem. I am using read() function provided by the Win32::SerialPort module to read a character at a time. I have written a wrapper over the read() function to read a 'line' i.e. a string of characters terminated by '\n' or '\r' which I have pasted below: 

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]

The above code most probably will not work or wont even compile, I just pulled out some parts of my code so as to give an idea.

Using my entire code, I am able to dump tens of thousands of lines which are repetitive i.e. same set of data is collected with changing conditions using a loop.
THE PROBLEM:::::::::::: While reading characters from the hardware I stop getting the characters and the readline function 'hangs'. This occurs after previous tens of iterations of loops went through without any hitch.

After stopping the perl script, I communicate with my hardware (modem) using hyperterm programme provided by Windows and see that communication with hardware proceeds without any glitch on the hyperterm.

I have been suggested to increase the buffer size from 4kB to 8kB which I did and which did not help now there is suggestion to increase it to 16kB which I will do but it takes lot of time (a few hours) before such problem recurs.
Kindly help, I am new to Perl and not a computer science graduate. Regards, pdeshpan.

Replies are listed 'Best First'.
Re: Win32::SerialPort code hanging while reading a 'line'
by TGI (Parson) on Jul 25, 2008 at 19:24 UTC

    Is there a reason you are using your own wrapper instead of lookfor? It won't block if there is no incoming line like your wrapper will.

    Here's some untested code that is structured much the same way as my other serial code. $p is the serial port object. 

    $p->are_match( "\r", "\n" );

while () {
    if( my $line = $p->lookfor ) {
        Process_Line( $line );
    }
    
    if( $p->write_done(0) ) {
        my $command = Fetch_Command();
        $p->write( $command ) if $command;
    }

    sleep 1;
}

    [download]


    TGI says moo

[reply]
[d/l]
Re: Win32::SerialPort code hanging while reading a 'line'
by poolpi (Hermit) on Jul 25, 2008 at 12:51 UTC

    Do you use the XS version of Win32::SerialPort?

    From the doc:

    Buffers The size of the Win32 buffers are selectable with buffers. But each read method currently uses a fixed internal buffer of 4096 bytes. This can be changed in the Win32API::CommPort source and read with internal_buffer. The XS version will support dynamic buffer sizing. Large operations are automatically converted to multiple smaller ones by the tied FileHandle methods.

    Another idea :
    Maybe do you need to purge the buffer sometimes?
    $PortObj->lookclear; # empty buffers

    See Methods used with Tied FileHandles ,

    hth,
    PooLpi

    'Ebry haffa hoe hab im tik a bush'. Jamaican proverb
[reply]
[d/l]
Re: Win32::SerialPort code hanging while reading a 'line'
by jethro (Monsignor) on Jul 25, 2008 at 13:46 UTC
    I know nothing about the module you use, but maybe closing and reopening the filehandle as soon as the loop in write_pd_data receives only empty strings for a while, might work.
[reply]
Re: Win32::SerialPort code hanging while reading a 'line'
by Anonymous Monk on Jul 25, 2008 at 12:27 UTC
    $foo->debug(1);
[reply]
[d/l]

Back to Seekers of Perl Wisdom