view release on metacpan or  search on metacpan

lib/Stream/Reader.pm  view on Meta::CPAN

package Stream::Reader;

use 5.005;
use strict;

our $VERSION = '0.09';

# Global/system variables

our $CODE;
our $AUTOLOAD;
our $Shift;

# Autoloaded code
$CODE ||= {

# Constructor
new => <<'ENDC',
  my $class = shift;
  my $input = shift;
  my $attr  = ( ref($Shift = shift) eq 'HASH' )? $Shift : {};
  my $self  = {
      # System parameters
    input    => $input,
    inpos    => 0,
    inlimit  => ( defined($attr->{Limit}) and $attr->{Limit} >= 0 )? $attr->{Limit} : 1e10,
    buffsize => ( defined($attr->{BuffSize}) and $attr->{BuffSize} >= 0 )? $attr->{BuffSize} : 32_768,
    bufferA  => '',
    bufferB  => '',
    status   => 1,
      # System flags
    mode_B  => ( $attr->{Mode} and index(uc($attr->{Mode}),'B') != -1 ),
    mode_U  => ( $attr->{Mode} and index(uc($attr->{Mode}),'U') != -1 ),
      # Statistic parameters
    Match  => '',
    Readed => 0,
    Stored => 0,
    Total  => 0,
    Error  => 0
  };
  return bless( $self => $class );
ENDC

# Destructor
DESTROY => <<'ENDC',
  return 1;
ENDC

# Public method
readto => <<'ENDC',
  my $self  = shift;
  my $delim = ( ref($Shift = shift) eq 'ARRAY' )? $Shift : [$Shift];
  my $attr  = ( ref($Shift = shift) eq 'HASH' )? $Shift : {};
  my $limit = ( defined($attr->{Limit}) and $attr->{Limit} >= 0 )? $attr->{Limit} : 1e10;
  my $wcase = ( $attr->{Mode} and index(uc($attr->{Mode}),'I') != -1 );
  my $max_d = 0;
  my $min_d = 1e10;
  my $error;
  my $rsize;

  # Preparing:
  #  - reseting some statistic variables
  @$self{ qw(Readed Stored Match) } = ( (0)x2, '' );
  #  - initialize output stream, if this is SCALAR and initialization required
  if( UNIVERSAL::isa($attr->{Out},'SCALAR')
    and !( defined(${$attr->{Out}}) and $attr->{Mode} and index(uc($attr->{Mode}),'A') != -1 )
  ) {
    ${$attr->{Out}} = '';
  }
  #  - maximal and minimal delimiter length detection
  foreach( @$delim ) {
    $max_d = length if $max_d < length;
    $min_d = length if $min_d > length;
  }
  #  - checking status and delimiter(s) presents
  unless( $self->{status} and $max_d ) {
    return $self->{status};
  } else {
    # Processing:
    while(1) {
      #  - searching
      if( length($self->{bufferA}) >= $min_d ) {
        my $found = 1e10;
        my $buffer;
        if( $wcase ) {
          $buffer = \( $self->{mode_B}? $self->{bufferB} : lc($self->{bufferA}) );
        }
        foreach( @$delim ) {
          my $pos = $wcase? index($$buffer,lc) : index($self->{bufferA},$_);
          if( $pos != -1 and $pos < $found ) {
            $found = $pos;
            $self->{Match} = $_;
          }
        }
        if( $found < 1e10 ) {
          if( !$error and $self->{Stored} < $limit ) {
            $rsize = $found;
            $rsize = $limit - $self->{Stored} if( $rsize > $limit - $self->{Stored} );
            $error = !$self->_write( $attr->{Out}, \(substr( $self->{bufferA}, 0, $rsize )) );
            $self->{Stored} += $rsize unless $error;
          }