Skip Menu |
 

This queue is for tickets about the IO-BufferedSelect CPAN distribution.

Report information
The Basics
Id: 68063
Status: open
Priority: 0/
Queue: IO-BufferedSelect

People
Owner: Nobody in particular
Requestors: john.kumpf [...] intel.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: bug in IO::BufferedSelect
Date: Mon, 9 May 2011 19:53:08 -0700
To: "bug-IO-BufferedSelect [...] rt.cpan.org" <bug-IO-BufferedSelect [...] rt.cpan.org>
From: "Kumpf, John" <john.kumpf [...] intel.com>
Download (untitled) / with headers
text/plain 722b
i really like this module, but i believe i have confirmed a bug in the read_line func. see the code excerpt below: sub read_line($;$@) { #... for( my $is_first = 1 ; 1 ; $is_first = 0 ) { # If we have any lines in buffers, return those first my @result = (); foreach my $idx( 0..$#{$self->{handles}} ) { next unless $use_idx{$idx}; if($self->{buffers}->[$idx] =~ s/(.*\n)//) { push @result, [ $self->{handles}->[$idx], $1 ]; } elsif($self->{eof}->[$idx]) { # NOTE: we discard any unterminated data at EOF push @result, [ $self->{handles}->[$idx], undef ]; } #### BUG #### BUG not full line, not eof, we may have a partial line, need to sysread again #### BUG }
Subject: bug in IO::BufferedSelect does not handle when sysread returns less than 1 line
From: john.kumpf [...] intel.com
Download (untitled) / with headers
text/plain 847b
On Mon May 09 22:54:18 2011, john.kumpf@intel.com wrote: Show quoted text
> i really like this module, but i believe i have confirmed a bug in the > read_line func. > > see the code excerpt below: > > > sub read_line($;$@) > { > #... > > for( my $is_first = 1 ; 1 ; $is_first = 0 ) > { > # If we have any lines in buffers, return those first > my @result = (); > > foreach my $idx( 0..$#{$self->{handles}} ) > { > next unless $use_idx{$idx}; > > if($self->{buffers}->[$idx] =~ s/(.*\n)//) > { > push @result, [ $self->{handles}->[$idx], $1 ]; > } > elsif($self->{eof}->[$idx]) > { > # NOTE: we discard any unterminated data at EOF > push @result, [ $self->{handles}->[$idx], undef ]; > } > #### BUG > #### BUG not full line, not eof, we may have a partial line, need > to sysread again > #### BUG > }
Subject: IO-BufferedSelect.patch
diff --git a/lib/perl/cpan_5_10_0-64/src/IO-BufferedSelect/lib/IO/BufferedSelect.pm b/lib/perl/cpan_5_10_0-64/src/IO-BufferedSelect/lib/IO/BufferedSelect.pm index 8b8ee37..b39bfb8 100644 --- a/lib/perl/cpan_5_10_0-64/src/IO-BufferedSelect/lib/IO/BufferedSelect.pm +++ b/lib/perl/cpan_5_10_0-64/src/IO-BufferedSelect/lib/IO/BufferedSelect.pm @@ -1,9 +1,24 @@ +# -*-mode: perl; indent-tabs-mode: t; perl-indent-level: 8; -*- package IO::BufferedSelect; use strict; use warnings; use IO::Select; +use Data::Dumper; +sub DumpTerse { # distinct from global ::DumpTerse + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Sortkeys = 1; + Dumper @_; +} + +our $Dbg = 0 unless defined $Dbg; +sub dbgbs { + return unless $Dbg; + my $msg = shift; + print STDERR "dbgbs: $msg\n"; +} + =head1 NAME IO::BufferedSelect - Line-buffered select interface @@ -100,17 +115,23 @@ EOF" is to be interpreted in the buffered sense: if a filehandle is at EOF but there are newline-terminated lines in C<BufferedSelect>'s buffer, C<read_line> will continue to return lines until the buffer is empty. +If C<BufferedSelect> times out, C<read_line> will return an empty list. + =cut sub read_line($;$@) { + dbgbs("read_line($_[0],$_[1])"); my $self = shift; my ($timeout, @handles) = @_; + my $beg_time; + # Convert @handles to a "set" of indices my %use_idx = (); if(@handles) { + dbgbs("read_line($_[0]) handles = (@handles)"); foreach my $idx( 0..$#{$self->{handles}} ) { $use_idx{$idx} = 1 if grep { $_ == $self->{handles}->[$idx] } @handles; @@ -118,47 +139,78 @@ sub read_line($;$@) } else { + dbgbs("read_line($_[0]) all handles"); $use_idx{$_} = 1 foreach( 0..$#{$self->{handles}} ); } - for( my $is_first = 1 ; 1 ; $is_first = 0 ) + my $timed_out = 0; + for( my $is_first = 1 ; $is_first || ! $timed_out ; $is_first = 0 ) { + dbgbs("read_line($_[0]) is_first='$is_first' use_idx=".DumpTerse(\%use_idx)); # If we have any lines in buffers, return those first my @result = (); + dbgbs("read_line($_[0]) is_first='$is_first' scalar result=".scalar @result); foreach my $idx( 0..$#{$self->{handles}} ) { + dbgbs("read_line($_[0]) idx='$idx'"); next unless $use_idx{$idx}; if($self->{buffers}->[$idx] =~ s/(.*\n)//) { + dbgbs("read_line($_[0]) idx='$idx' have line"); push @result, [ $self->{handles}->[$idx], $1 ]; } elsif($self->{eof}->[$idx]) { + dbgbs("read_line($_[0]) idx='$idx' eof NOTE: we discard any unterminated data at EOF self->{buffers}->[$idx]='$self->{buffers}->[$idx]'"); # NOTE: we discard any unterminated data at EOF push @result, [ $self->{handles}->[$idx], undef ]; } + else + { + dbgbs("read_line($_[0]) idx='$idx' is_first='$is_first' neither have a full line nor eof, ie we have a partial line: self->{buffers}->[$idx]='$self->{buffers}->[$idx]'"); + } } + dbgbs("read_line($_[0]) after foreach idx handles : result=[@result] scalar result=".scalar @result); # Only give it one shot if $timeout is defined - return @result if ( @result or (defined($timeout) and !$is_first) ); + #return @result if ( @result or (defined($timeout) and !$is_first) ); + return @result if ( @result or (defined($timeout) && $timed_out) ); + dbgbs("read_line($_[0]) ".localtime()." no result: doing select timeout='$timeout'"); # Do a select(), optionally with a timeout my @ready = $self->{selector}->can_read( $timeout ); + dbgbs("read_line($_[0]) ".localtime()." ready=(@ready)"); + unless (@ready) { + $timed_out = 1; + } # Read into $self->{buffers} + # if timed out, @ready will be empty foreach my $fh( @ready ) { + dbgbs("read_line($_[0]) fh='$fh'"); foreach my $idx( 0..$#{$self->{handles}} ) { + dbgbs("read_line($_[0]) fh='$fh' idx='$idx'"); next unless $fh == $self->{handles}->[$idx]; + dbgbs("read_line($_[0]) fh='$fh' idx='$idx' fh match"); next unless $use_idx{$idx}; + dbgbs("read_line($_[0]) fh='$fh' idx='$idx' fh match and use_idx=1"); my $bytes = sysread $fh, $self->{buffers}->[$idx], 1024, length $self->{buffers}->[$idx]; + dbgbs("read_line($_[0]) fh='$fh' idx='$idx' read done: bytes = '$bytes'"); $self->{eof}->[$idx] = 1 if($bytes == 0); } } } + if ($timed_out) { + dbgbs("read_line($_[0]) loop ended timed_out='$timed_out'(true), returning empty list"); + return (); + } + else { + die "code error: loop ended yet not timed_out"; + } }
Download (untitled) / with headers
text/plain 125b
Hi John, Sorry I fell off the radar! The patch looks good; let me upload a new version with the fix in place. Best, Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.