Processing input from 'while' loop in chunks based on information in each string?

I have many, many lines of text data representing events occurring on various dates. Each date is associated with ~500 or so events. Each event needs to be evaluated within the context of the other events occurring on that date, and only those other events. Since slurping all the data into an array and breaking it into smaller arrays is not feasible, memory-wise, I would like to use the recommended while loop procedure.

What I would like to do is the following: 1) pack an array with each line until the next line shows a different date; 2) process the array and clear it; 3) continue on packing the lines until you get to the next date, and so on.

So far, I'm using the following code, but it just seems to repeat too many things to be the most idiomatic solution:

my @chunk;
my $current;

while ( <FILEHANDLE> ) {
    my $date_of_this_line = ( split /\t/ )[0];
    unless ( defined $current and $curr开发者_如何学JAVAent eq $date_of_this_line ) {
        do { &process @chunk; undef @chunk } if @chunk;
        $current = $date_of_this_line;
    }
    push @chunk, $_;
}
do{ &process @chunk; undef @chunk } if @chunk;

Any ideas for a little bit better solution to this kind of thing? I ask because I'm sure I'm not the first one to do this!

EDIT I think I've got it! With the help of ysth's and FM's comments (below), I was able to reduce the solution to a few fewer lines of code without the repeating commands. The tradeoff is that I have to declare one more lexical variable before entering the while loop.

my @chunk;
my $current = 1;
my $date_of_line = 1;

while ( $date_of_line or @chunk ) {
    $date_of_line = defined( $_ = $FILEHANDLE ) ? ( split /\t/ )[0] : 0 and chomp;
    #the reason for 'and chomp'? chomp throws an error if $_ = $FILEHANDLE is not defined

    unless ( $current eq $date_of_line ) {
        process( splice( @chunk ) ) if @chunk;
        #thanks to ysth for pointing out how to process and clear @chunk in one stroke!
        $current = $date_of_line;
    }

    push @chunk, $_ if $date_of_line;
}

Not bad, eh? If I define the subroutine 'process' to give me a convenient little test, it confirms the results are what we want (that is... until I add more data and it screws up on me ;):

sub process {
    my @batch = @_;
    my $size = @batch;
    print "size is $size\n"; #simply tells me I'm getting the right size chunks;

    my $dates = keys %{ { map { ( split /\t/ )[0] => undef ) @batch } };
    print "number of different dates in batch: $games\n"; #should only be 1
}

Nope, that's generally how to do it. You can pass and clear the array at once with &process( splice(@chunk) ) though. There's a variation possible where you loop:

while( ! $eof || @chunk ) {
    $eof ||= defined( $_ = <FILEHANDLE> );
    if ( $eof || defined($current) && $current ne ( $date_of_this_line = ( split /\t/ )[0] ) ) {
        &process( splice(@chunk) ) if @chunk;
        $current = $date_of_this_line;
    }
    push @chunk, $_ unless $eof;
}

but that's kinda messy.

Here's a more wordy solution that illustrates the concept of a "chunk and commit" subroutine that you fabricate to preserve state and execute a callback according to your requirements.

use strict;
use warnings;

sub make_chunk_proc (&) {
    my( $callback ) = @_;
    my $grouping_key = ''; # start empty
    my @queue;
    return sub {
        if ( @_ ) { # add arguments to current chunk
            my $key = shift;
            return if $grouping_key and $key ne $grouping_key;
            $grouping_key = $key;
            push @queue, [ $key, @_ ];
            return 1;
        }
        else { # commit current chunk and reset state
            $callback->( \@queue );
            $grouping_key = '';
            @queue = ();
        }
    };
}

# ==== main ====

my $chunker = make_chunk_proc {
    my( $queue ) = @_;
    print "@$_\n" for @$queue;
    print '-' x 70, "\n";
};

while ( <> ) {
    chomp;
    my( $key, @rest ) = split /\t/;
    $chunker->( $key, @rest ) or do {
        $chunker->();
        $chunker->( $key, @rest );
    }
}
$chunker->(); # commit remaining stuff

With data like this:

2011-04-19  blabla
2011-04-19  blablub
2011-04-20  super
2011-04-20  total super
2011-04-21  weiter
2011-04-22  immer weiter
2011-04-24  immer weiter weiter

The result looks like this:

$ perl chunks.pl < chunks.txt
2011-04-19 blabla
2011-04-19 blablub
----------------------------------------------------------------------
2011-04-20 super
2011-04-20 total super
----------------------------------------------------------------------
2011-04-21 weiter
----------------------------------------------------------------------
2011-04-22 immer weiter
----------------------------------------------------------------------
2011-04-24 immer weiter weiter
----------------------------------------------------------------------

A few ideas:

(1) Set the previous date to some value (e.g., empty string), so you don't have to check whether it's defined in the loop.

(2) Modify process() so that it simply returns if @chunk is empty.

(3) If @chunk is a global, process() can reset it to empty.

(4) Other stuff worth considering: (a) use lexical file handles, (b) don't invoke process with a leading ampersand.