TouchStone Iterator

仕事がらTouchStone(Sパラメータ)をハンドリングする事が多いので、なんちゃってTouchStone Iteratorを作ってみました。
もっと、スマートに書けるような気もするけど、おいおい直して行きます。

use strict;
use warnings;

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

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

sub touchstone_iterator {
    my $spara = shift;

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

    my $position;
    my @buffer;
    while (<$fh>) {
	chomp();
	if (/\!/ or /\#/ or /^\s*$/) {
	    next;
	}
	if (/^\S/) {
	    $position = tell $fh;
	    @buffer = split(/\s+/);
	    last;
	}
    }

    return Iterator {
	local $_;
	seek $fh, $position, 0;
	my $pre_position;
	while (<$fh>) {
	    chomp();
	    $position = tell $fh;
	    if (/^\S/ && @buffer != 0) {
		my %data;
		my $freq = shift(@buffer);
		$data{"freq"} = $freq;
		$data{"data"} = [@buffer];
		@buffer = ();
		$position = $pre_position;
		return {%data};
	    } elsif (/^\S/) {
		@buffer = split(/\s+/);
	    } else {
		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 = touchstone_iterator($spara);

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

main(\@ARGV);