Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

line-by-line input with size limit

by martin (Pilgrim)
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 lurking in the Monastery: (7)
As of 2014-07-30 12:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (231 votes), past polls