やっぱミスってた

昨日書いたやつid:yukichanko:20081006はやっぱ間違ってたみたい。
比較的ポート数が多くて、1周波数が何行にもわたってる場合はいいんだけど、1行に1周波数のデータが全て書かれているような場合、ファイルハンドルが一時的に空になってしまうバグがあった。

と言うことで、修正版。

use strict;
use warnings;
use Data::Dumper;

sub NEXTVAL { $_[0]->() }

sub Iterator (&) { return $_[0] }

sub main_iterator {
    my $spara = shift;

    open(my $fh, "<", $spara) or die "Cannot open $spara";

    my $position = 0;
    my @buffer = ();

    return Iterator {
	local $_;
	seek $fh, $position, 0;
	my $pre_position = $position;

	while (<$fh>) {
	    chomp();

	    if (/\!/ or /\#/ or /^\s*$/) {
		next;
	    }

	    $position = tell $fh;
	    if (/^\S/ && @buffer != 0) {
		print "hoge1\n";
		my %data;
		my $freq = shift(@buffer);
		$data{"freq"} = $freq;
		$data{"data"} = [@buffer];
		@buffer = ();
		$position = $pre_position;
		return {%data};
	    } elsif (/^\S/) {
		print "hoge2\n";
		@buffer = split(/\s+/);
	    } else {
		print "hoge3\n";
		s/^\s*//;
		push(@buffer, split(/\s+/));
	    }
	    $pre_position = $position;
	}

	if (@buffer != 0) {
	    my %data;
	    my $freq = shift(@buffer);
	    $data{"freq"} = $freq;
	    $data{"data"} = [@buffer];
	    @buffer = ();
	    return {%data};
	} else {
	    return;
	}
    };
}

sub main {
    my ($argv_ref) = @_;

    my $spara = $argv_ref->[0];

    my $it = main_iterator($spara);

    while (defined($_ = NEXTVAL($it))) {
	my $freq = $_->{"freq"};
	my $data = $_->{"data"};
	print "Freq: $freq\n";
	print "Data: @{$data}\n";
    }
}

main(\@ARGV);