reindex

#!/usr/bin/perl
#: reindex.pl
#: reindex .t files for Test::Base based test files
#: Copyright (c) 2006 Agent Zhang
#: 2006-04-27 2006-05-09

use strict;
use warnings;

#use File::Copy;
use Getopt::Std;

my %opts;
getopts('hb:', \%opts);
if ($opts{h} or ! @ARGV) {
    die "Usage: reindex [-b 0] t/*.t\n";
}

my $init = $opts{b};
$init = 1 if not defined $init;

my @files = map glob, @ARGV;
for my $file (@files) {
    next if -d $file or $file !~ /\.t_?$/;
    reindex($file);
}

sub reindex {
    my $file = $_[0];
    open my $in, $file or
        die "Can't open $file for reading: $!";
    my @lines;
    my $counter = $init;
    my $changed;
    while (<$in>) {
        s/\r$//;
        my $num;
        s/ ^ === \s+ TEST \s+ (\d+)/$num=$1; "=== TEST " . $counter++/xie;
        next if !defined $num;
        if ($num != $counter-1) {
            $changed++;
        }
    } continue {
        push @lines, $_;
    }
    close $in;
    my $text = join '', @lines;
    $text =~ s/(?x) \n+ === \s+ TEST/\n\n\n\n=== TEST/ixsg;
    $text =~ s/__(DATA|END)__\n+=== TEST/__${1}__\n\n=== TEST/;
    #$text =~ s/\n+$/\n\n/s;
    if (! $changed and $text eq join '', @lines) {
        warn "reindex: $file:\tskipped.\n";
        return;
    }
    #File::Copy::copy( $file, "$file.bak" );
    open my $out, "> $file" or
        die "Can't open $file for writing: $!";
    binmode $out;
    print $out $text;
    close $out;

    warn "reindex: $file:\tdone.\n";
}