Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

line-by-line input with size limit

by martin (Friar)
on Jun 28, 2007 at 21:56 UTC ( #623991=snippet: print w/ replies, xml ) Need Help??

Description: Elaborating on my question Safely reading line by line, I have tried to put together a IO::Handle::getline variant with a size constraint on its return value.

It could be used like this:

my $fh = IO::File::Narrow->new('/path/to/file', 'r'); local $IO::File::Narrow::max_input_record_length = 80; local $/ = "\n"; while (defined(my $line = $fh->getline)) { # do something with line }

It turns out supporting various flavours of $/ is not much fun. I am not too fond of dynamically scoped variables either, but IO::* modules have them anyway.

package IO::File::Narrow;

use 5.006001;
use strict;
use base qw(IO::File);
use Carp qw(croak);

our $VERSION = '0.01';

our $max_input_record_length = 1024;

sub getline {
    @_ == 1 or croak 'usage: $io->getline()';
    my $this = shift;
    my $line = q{};
    return undef if $this->eof;
    my $irs = ref($this)->input_record_separator;

    if (!defined $irs) {
        while (defined(my $ch = $this->getc)) {
            $line .= $ch;
            croak 'input record too long'
                if $max_input_record_length < length $line;
        }
        return $line;
    }
    if (ref $irs) {
        my $frl = int(${$irs}) || 0;
        while (defined(my $ch = $this->getc)) {
            $line .= $ch;
            croak 'input record too long'
                if $max_input_record_length < length $line;
            return $line if $frl == length $line;
        }
        return $line;
    }
    if (1 == length $irs) {
        while (defined(my $ch = $this->getc)) {
            $line .= $ch;
            croak 'input record too long'
                if $max_input_record_length < length $line;
            return $line if $ch eq $irs;
        }
        return $line;
    }
    if (q{} ne $irs) {
        while (defined(my $ch = $this->getc)) {
            $line .= $ch;
            croak 'input record too long'
                if $max_input_record_length < length $line;
            return $line if substr($line, -length $irs) eq $irs;
        }
        return $line;
    }
    else {
        my $pch = q{};
        while (defined(my $ch = $this->getc)) {
            $line .= $ch;
            croak 'input record too long'
                if $max_input_record_length < length $line;
            if ("\n" eq $ch && "\n" eq $pch) {
                while (defined($ch = $this->getc)) {
                    if ("\n" ne $ch) {
                        $this->ungetc(ord $ch);
                        return $line;
                    }
                }
                return $line;
            }
            $pch = $ch;
        }
        return $line;
    }
}

sub getlines {
    @_ == 1 or croak 'usage: $io->getlines()';
    wantarray or
        croak 'Can\'t call $io->getlines in a scalar context, use $io-
+>getline';
    my $this = shift;
    my @buffer = ();
    while (defined(my $line = $this->getline)) {
        push @buffer, $line;
    }
    return @buffer;
}

1;
__END__
# TODO: pod documentation
Comment on line-by-line input with size limit
Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://623991]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (14)
As of 2015-07-07 14:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (89 votes), past polls