File-Stream
view release on metacpan - search on metacpan
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];
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.147 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )