package IRC::Buffer;

use strict;
use warnings;

use IO::Select;
use Carp;

#################
# 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) = @_;

  unless(fileno($fh) =~ /^\d+$/)
    {
    croak "$fh is not a valid filehandle";
    return;
    }
  $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()

  return 1;
  }

sub remove
  {
  my($self, $fh) = @_;

  unless(fileno($fh) =~ /^\d+$/)
    {
    croak "$fh is not a valid filehandle";
    return;
    }
  $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};

  return 1;
  }

sub set_pattern
  {
  my($self, $fh, $pattern) = @_;

  $self->{'Filehandles'}{$fh}{'Pattern'} = $pattern;
  }

sub set_size
  {
  my($self, $fh, $size) = @_;

  unless($size =~ /^\d$/)
    {
    croak "argument to \'set_size\' must be integer";
    return;
    }
  $self->{'Filehandles'}{$fh}{'Size'} = $size;

  return 1;
  }

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;

  unless($self->{'Filehandles'}{$fh})
    { return; }

  unless(@{$self->{'Filehandles'}{$fh}{'Queue'}})
    {
    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'}}) . "\n";
  }

####################
# 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;
    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;
  }
[download]