1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#!/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";
}
|
