evil code alert:
package IO::Select::Buffer;
use strict;
use warnings;
use IO::Select;
#################
# Class Methods #
#################
sub new
{
my $self = bless({}, shift);
$self->{'IO'} = IO::Select->new;
@{$self->{'FH'}} = ();
$self->{'Filehandles'} = {};
return $self;
}
##################
# Object Methods #
##################
sub add
{
my($self, $fh) = @_;
$self->{'IO'}->add($fh);
push(@{$self->{'FH'}}, $fh);
@{$self->{'Filehandles'}{$fh}{'Queue'}} = (); #an array tha
+t will hold complete lines
$self->{'Filehandles'}{$fh}{'Fract'} = ''; #a scalar to
+store a fragment of a line
$self->{'Filehandles'}{$fh}{'Pattern'} = '\r\n|\r|\n'; #default line
+end pattern
$self->{'Filehandles'}{$fh}{'Size'} = 4096; #amount of by
+tes read per sysread()
}
sub remove
{
my($self, $fh) = @_;
$self->{'IO'}->remove($fh);
my $c = 0;
foreach(@{$self->{'FH'}})
{
if($_ eq $fh)
{
splice(@{$self->{'FH'}}, $c, 1);
last;
}
else
{ $c++; }
}
delete $self->{'Filehandles'}{$fh};
}
sub ready
{
my $self = shift;
my @ready = $self->{'IO'}->can_read(0.001);
my $already_listed;
foreach my $fh (@{$self->{'FH'}})
{
if(@{$self->{'Filehandles'}{$fh}{'Queue'}})
{
foreach(@ready)
{
if($_ eq $fh)
{
$already_listed = 1;
last;
}
}
}
unless($already_listed)
{ push(@ready, $fh); }
}
return @ready;
}
sub sysreadline
{
my($self, $fh) = @_;
my $read;
if(@{$self->{'Filehandles'}{$fh}{'Queue'}})
{ return shift(@{$self->{'Filehandles'}{$fh}{'Queue'}}); }
else
{
unless($read = $self->_fill_buffer($fh))
{ return $read; }
while($read == $self->{'Filehandles'}{$fh}{'Size'})
{ $read = $self->_fill_buffer($fh); }
return shift(@{$self->{'Filehandles'}{$fh}{'Queue'}});
}
}
####################
# Internal methods #
####################
sub _fill_buffer
{
#reads x bytes in from the specified filehandle, chops them up into
+lines and returns
# the number of bytes read when succesful, 0 when eof or undef when
+an error occurs.
my($self, $fh) = @_;
my $pattern = $self->{'Filehandles'}{$fh}{'Pattern'};
my($chunk, $read);
#attempt to perform a sysread on the filehandle and process the data
+.
# if the read fails it will return 0 for end of file or undef for a
+read error
# while setting $! to the reason for the error
unless($read = sysread($fh, $chunk, $self->{'Filehandles'}{$fh}{'Siz
+e'}))
{ return $read; }
#there is a possibility that what we have just read is simply the mi
+ddle section of a
# single line, so check for that first:
unless($chunk =~ /$pattern/)
{
$self->{'Filehandles'}{$fh}{'Fract'} .= $chunk;
# print "\$self->{'Filehandles'}{$fh}{'Fract'} is now: $self->{'Fil
+ehandles'}{$fh}{'Fract'}\n";
return 0;
}
#if the first character of $chunk is a newline, then what we current
+ly have listed as a broken line
# from the last read is in fact a regular full line, so we can go ah
+ead and add it to the queue.
if(($chunk =~ /^[$pattern]/) && ($self->{'Filehandles'}{$fh}{'Fract'
+}))
{
push(@{$self->{'Filehandles'}{$fh}{'Queue'}}, $self->{'Filehandles
+'}{$fh}{'Fract'});
$self->{'Filehandles'}{$fh}{'Fract'} = '';
}
my @lines = split(/$pattern/, $chunk);
#otherwise if we still have a broken line sitting around, merge it w
+ith the first line of @lines
# and then add it to the queue
if($self->{'Filehandles'}{$fh}{'Fract'})
{
push(@{$self->{'Filehandles'}{$fh}{'Queue'}}, $self->{'Filehandles
+'}{$fh}{'Fract'} . shift(@lines));
$self->{'Filehandles'}{$fh}{'Fract'} = '';
}
#if the last character of $chunk is a newline, then there is no actu
+al broken line in this batch,
# so we can simply process all the lines in order. otherwise make su
+re the last line in @lines is
# treated as a fragment
unless($chunk =~ /[$pattern]$/)
{ $self->{'Filehandles'}{$fh}{'Fract'} = pop(@lines); }
#now simply push all of @lines into the queue
push(@{$self->{'Filehandles'}{$fh}{'Queue'}}, @lines);
return $read;
}
1;
|