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
> }
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";
+ }
}
