in reply to Thrashing on very large lines

open(my $fh_in, '<', ...)
   or die("Unable to open input file: $!\n");

open(my $fh_good, '>', ...)
   or die("Unable to open 'good' output file: $!\n");

open(my $fh_bad, '>', ...)
   or die("Unable to open 'bad' output file: $!\n");

binmode($fh_in);
binmode($fh_good);
binmode($fh_bad);

my $buf  = '';
my $skip = 0;

local $/ = "\r\n";  # Because we're using binmode.
my $rec_len = 1000 + length($/);

# Buffer size can be up to $blk_size + $rec_len bytes.
my $blk_size = 8192;

for (;;) {
   my $read = read($fh_in, $buf, $blk_size, length($ofs));

   defined $read
      or die("Unable to read input file: $!\n")

   while (length($buf) >= $rec_len) {
      my $pos = index($buf, $/);

      if ($pos < 0) {
         print $fh_bad $buf;
         $buf = '';
         $skip = 1;
      } else {
         $pos += $ofs + length($/);
         my $bad = $skip || $pos != $rec_len;
         print { $bad ? $fh_bad : $fh_good } (substr($buf, 0, $pos));
         substr($buf, 0, $pos, '');
         $skip = 0;
      }
   }

   if ($read == 0) {
      print $fh_bad $buf if length $buf;
      last;      
   }
}

[download]

Untested.

Update: Cleanup.

Replies are listed 'Best First'.
Re^2: Thrashing on very large lines
by chr1so (Acolyte) on Apr 20, 2006 at 20:12 UTC
    Thanks! This is a little quicker, but more importantly it doesn't convert the line endings like the one-liner.

    There was one bug when $buf was overwritten by the read() command. I've cleaned it up until it sorts the same number of records as the one-liner. 

    scalar @ARGV == 3 
   or die "usage: this.pl <suspect.txt> <good.txt> <bad.txt>\n";

open(my $fh_in, '<', shift) 
   or die("Unable to open input file: $!\n");
open(my $fh_good, '>', shift) 
   or die("Unable to open 'good' output file: $!\n");
open(my $fh_bad, '>', shift)
   or die("Unable to open 'bad' output file: $!\n");

binmode($fh_in);
binmode($fh_good);
binmode($fh_bad);

my $buf    = '';  # stores the working buffer
my $newbuf = '';  # used for reading next chunk
my $is_continued = 0; # remembers that the current record is longer th
+an it appears

local $/ = "\n";  # Because we're using binmode.
my $rec_len = 1000 + length($/);

# Working buffer size can be up to $blk_size + $rec_len bytes.
my $blk_size = 8192;

for (;;) {
   my $read = read($fh_in, $newbuf, $blk_size);

   defined $read
      or die("Unable to read input file: $!\n");
      
   $buf .= $newbuf;

   # if it didn't read anything new, flush the buffer and end
   if ($read == 0) { 
      print $fh_bad $buf if length $buf;
      last;      
   }

   while (length($buf) >= $rec_len) {
      my $pos = index($buf, $/);

      if ($pos < 0) {  # no line ending, but long enough
         print $fh_bad $buf;  
         $buf = ''; # flush, ends while
         $is_continued = 1;  
         
      } else {  # line ending found
         $pos += length($/);
         my $is_bad = $is_continued || $pos != $rec_len;
         print {$is_bad ? $fh_bad : $fh_good} (substr($buf, 0, $pos));
         substr($buf, 0, $pos, '');  # clip written section
         $is_continued = 0; # reset whenever line ending found
      }
   }
}

    [download]
[reply]
[d/l]

      Moving the check for $read == 0 was quite appropriate. Admittedly, $skip was not optimally named. (I'd prefer $in_bad_record. It was called $skip because I initially discarded the bad stuff. I didn't notice you wanted to keep it.) However, your fix of the bug in read wasn't optimal.

      Me: 

         my $read = read($fh_in, $buf, $blk_size, length($ofs));

      [download]

      You: 

         my $read = read($fh_in, $newbuf, $blk_size);
   ...
   $buf .= $newbuf;

      [download]
      What it should be: 
         my $read = read($fh_in, $buf, $blk_size, length($buf));

      [download]
[reply]
[d/l]
[select]
        What it should be: 
        my $read = read($fh_in, $buf, $blk_size, length($buf));

        [download]
         I understand now. When I read the description for read(), I mistakingly thought it was for an offset in the file.

        Thanks again. This was a great help and learning experience.

[reply]
[d/l]

In Section Seekers of Perl Wisdom