Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Forsaken's scratchpad

by Forsaken (Friar)
on Jun 13, 2004 at 11:02 UTC ( #363802=scratchpad: print w/replies, xml ) Need Help??

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;
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (2)
As of 2021-11-30 09:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?