#!/usr/bin/env perl #: reindexes .t files for Test::Base based test files #: Copyright (c) Yichun Zhang 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 .= "\n"; #last line should end with newline $text =~ s/\n\n+\z/\n/sm; $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"; }