line-by-line input with size limit

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
}
[download]

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
[download]

Comment on line-by-line input with size limit Select or Download Code


Syntactic Confectionery Delight
	PerlMonks