Hi,
My response has not been so quick this time. I'm still haveing some
difficulty trying to understand what you are trying to accomplish. I
have not tried to combine things in this way before. In fact, I even
suggested it might not work very well in the docs...
"Because all the tied methods block, they should ALWAYS be used
with
timeout settings and are not suitable for background operations
and
polled loops. The B<sysread> method may return fewer characters
than
requested when a timeout occurs. The method call is still
considered
successful. If a B<sysread> times out after receiving some
characters,
the actual elapsed time may be as much as twice the programmed
limit.
If no bytes are received, the normal timing applies."
The examples did not have timeouts set. And used polled loops. In
particular, the use of $limit in this subroutine is confusing to me:
sub get_dataz{
my ($limit)=@_;
if (!defined $limit){$limit=900000}
my $res="";
my $count=0;
my $ok=1;
while (1){
$count++;
my $line=<FH>;
if (defined $line){
if ($line=~/(.*)/){
$res="$1";
#print "->>> $res\n";
return ($ok,$count,$res);
}
}
if (defined $limit and $count>$limit){
$ok=0;last;
}
}
return ($ok,$count,$res);
}
There may also be timing details of the hardware you are using that is
involved. I need to dig out some old systems with "real" (and opposed to
USB) ports that I can configure to match what you are using. I have some
in storage - but it might be a while until I can get to it.
What you proposed as a fix is likely to break other people's code since
it alters the return conditions of 'lookfor'. So I can't easily make a
change like that unless I can arrange it as an option (which also
maintains backwards compatibility).
I'll continue to look at it. But I can't promise anything quickly.
Sorry.
-bill
On Thu, 2011-05-12 at 17:40 -0400, harada via RT wrote:
Show quoted text> Queue: Win32-SerialPort
> Ticket <URL:
https://rt.cpan.org/Ticket/Display.html?id=68145 >
>
> Thank you for quick resoponse.
>
> I have attached complete examples of PC1 and PC2.
>
> Kazushige Harada
>
>
> (2011/05/13 0:15), Bbirthisel@aol.com via RT wrote:
> > <URL:
https://rt.cpan.org/Ticket/Display.html?id=68145>
> >
> >
> > Please send the complete examples from PC1 and PC2, including all initialization and the code to tie the filehandle.
> > I'll try to duplicate the problem. This is the first report I have received of an issue like this.
> >
> > -bill
> >
> >
> >
> >
> > -----Original Message-----
> > From: harada via RT<bug-Win32-SerialPort@rt.cpan.org>
> > To: undisclosed-recipients:;
> > Sent: Thu, May 12, 2011 9:36 am
> > Subject: [rt.cpan.org #68145] Filehandle read bug/bugfix
> >
> >
> > Thu May 12 09:36:20 2011: Request 68145 was acted upon.
> > ransaction: Ticket created by haradaf@ares.eonet.ne.jp
> > Queue: Win32-SerialPort
> > Subject: Filehandle read bug/bugfix
> > Broken in: (no value)
> > Severity: (no value)
> > Owner: Nobody
> > Requestors: haradaf@ares.eonet.ne.jp
> > Status: new
> > Ticket<URL:
https://rt.cpan.org/Ticket/Display.html?id=68145>
> >
> > ello,
> > I found a problem using Win32::SerialPort
> > VERSION-0.19 with perl 5.10.1) for tied file handle.
> > $ob->are_match("\n");
> > <PC1 sending>
> > rint FH "12\n34\n56\n78\n";
> > <PC2 receiving>
> > hile (1){
> > data=<FH>
> >
> > rint "$data";
> > esult => 12\n34\n56\n
> > can't get 78\n;
> > I searched Win32::SerialPort source-code as follows.
> > Inside "sub lookfor",I added print "$loc\n".
> > he outputs are
> > 2\n3 =>$data=12\n
> >
> > n =>$data=34\n
> > 6\n78\n =>$data=56\n
> > As there was no more data input,no extra processing ocurred.
> > o,78\n won't be received.
> > I fixed this as follows.
> > if ($size) {
> > y ($bbb, $iii, $ooo, $eee) = status($self);
> > f ($iii> $size) { $size = $iii; }
> > $count_in, $string_in) = $self->read($size);
> > eturn if ($count_in==0 and $loc eq ""); #modified from "return unless
> > $count_in)"
> >
> > t looks well for my application,but I found "sub streamline" has the
> > ame code.
> > f hope next version fix all these problems.
> > Best regards,
> > azushige Harada
> >
> >
> >
> >
>
>
> plain text document attachment (serial_bugtest_pc1.pl)
> #PC1 program <send data>
>
> use strict;
> use warnings;
> use Win32::SerialPort 0.06;
>
> #--------------------------------------------------------------------------------
> my $portname = "COM1";
> #--------------------------------------------------------------------------------
> my $quiet=1;
> my $ob;
> #--------------------------------------------------------------------------------
> my $cr=chr(0x0d);
> #--------------------------------------------------------------------------------
> $ob = new Win32::SerialPort($portname,$quiet) or die "Can't open $portname:$^E\n";
> $ob->databits(8);
> $ob->baudrate(4800);
> $ob->parity("even");
> $ob->stopbits(2);
> $ob->buffers(4096,4096);
> $ob->eof_char("0x0");
>
> $ob->write_settings or undef $ob;
> $ob->save("outpara1.asc");
> $ob->close or die;
> undef $ob;
>
> $ob=tie (*FH,'Win32::SerialPort',"outpara1.asc") or die "Can't tie;$^E\n";
> $ob->linesize(1);
> $ob->are_match("$cr");
>
> #start
> #--------------------------------------------------------------------------------
> print FH "12${cr}34${cr}56${cr}";
> sleep 1000;
> #--------------------------------------------------------------------------------
>
> plain text document attachment (serial_bugtest_pc2.pl)
> #PC2 program <receive data>
>
> use strict;
> use warnings;
> use Win32::SerialPort 0.06;
>
> #=================================================
> my $portname = "COM1";
> #=================================================
> my $quiet=1;
> my $ob;
> my $cr=chr(0x0d);
> #-------------------------------------------------
> $ob = new Win32::SerialPort($portname,$quiet) or die "Can't open $portname:$^E\n";
> $ob->databits(8);
> $ob->baudrate(4800);
> $ob->parity("even");
> $ob->stopbits(2);
> $ob->buffers(4096,4096);
> $ob->eof_char("0x0");
> $ob->write_settings or undef $ob;
> $ob->save("outpara2.asc");
> $ob->close or die;
> undef $ob;
>
> $ob=tie (*FH,'Win32::SerialPort',"outpara2.asc") or die "Can't tie;$^E\n";
> $ob->linesize(1);
> $ob->are_match("$cr");
>
> #start
> #--------------------------------------------------------------------------------
> while (1){
> my ($ok,$count,$res)=get_dataz(100);
> if ($ok==1){print "ok:$ok\n$res\n";}
> }
> #--------------------------------------------------------------------------------
>
> sub get_dataz{
> my ($limit)=@_;
> if (!defined $limit){$limit=900000}
> my $res="";
> my $count=0;
> my $ok=1;
>
> while (1){
> $count++;
> my $line=<FH>;
> if (defined $line){
> if ($line=~/(.*)/){
> $res="$1";
> #print "->>> $res\n";
> return ($ok,$count,$res);
> }
> }
> if (defined $limit and $count>$limit){
> $ok=0;last;
> }
> }
> return ($ok,$count,$res);
> }
