view release on metacpan or  search on metacpan

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

            my $string = "$_";
            qr/\Q$string\E/
        }
      } @terms;
    
    my $re       = '(' . join( ')|(', @regex_tokens ) . ')';
    my $compiled = qr/$re/s;

    while (1) {
        my @matches = $self->{buffer} =~ $compiled;
        if ($End_Of_String or not @matches) {
            $End_Of_String = 0;
            return undef unless $self->fill_buffer();
            next;
        }
        else {
            my $index = undef;
            for ( 0 .. $#matches ) {
                $index = $_, last if defined $matches[$_];
            }
            die if not defined $index;    # sanity check
            my $match = $matches[$index];
            $self->{buffer} =~ s/^(.*?)\Q$match\E//s or die;
            return ( $1, $match );
        }
    }
}

=head2 fill_buffer

It is unlikely that you will need to call this method directly.
Reads more data from the internal filehandle into the buffer.
First argument may be the number of bytes to read, otherwise the
'read_length' attribute is used.

Again, call this on the handler object, not the file handle.

=cut

sub fill_buffer {
    my $self = shift;
    my $length = shift || $self->{read_length};
    my $data;
    my $bytes = read( $self->{fh}, $data, $length );
    return 0 if not $bytes;
    $self->{buffer} .= $data;
    return $bytes;
}

sub TIEHANDLE {
    my $class = shift;
    my $fh    = shift;
    my $self  = {
        fh          => $fh,
        read_length => 1024,
        separator   => undef,
        buffer      => '',
        die_on_anchors => 1,
        @_
    };
    bless $self => $class;
}

sub READLINE { goto &readline; }

sub PRINT {
    my $self = shift;
    my $buf = join( defined $, ? $, : "", @_ );
    $buf .= $\ if defined $\;
    $self->WRITE( $buf, length($buf), 0 );
}

sub PRINTF {
    my $self = shift;

    my $buf = sprintf( shift, @_ );
    $self->WRITE( $buf, length($buf), 0 );
}

sub GETC {
    my $self = shift;

    my $buf;
    $self->READ( $buf, 1 );
    return $buf;
}

sub READ {
    croak if @_ < 3;
    my $self   = shift;
    my $bufref = \$_[0];
    $$bufref = '' if not defined $$bufref;
    my ( undef, $len, $offset ) = @_;
    $offset = 0 if not defined $offset;
    if ( length $self->{buffer} < $len ) {
        my $bytes = 0;
        while ( $bytes = $self->fill_buffer()
                and length( $self->{buffer} ) < $len )
        { }

        if ( not $bytes ) {
            my $length_avail = length( $self->{buffer} );
            substr( $$bufref, $offset, $length_avail,
                    substr( $self->{buffer}, 0, $length_avail, '' ) );
            return $length_avail;
        }

        # only reached if buffer long enough.
    }
    substr( $$bufref, $offset, $len, substr( $self->{buffer}, 0, $len, '' ) );
    return $len;
}

sub WRITE {
    my $self = $_[0];
    my $fh   = $self->{fh};
    print $fh substr( $_[1], 0, $_[2] );
}

sub TELL {
    my $self = $_[0];