[perl5.git] / Porting / bump-perl-version

#!/usr/bin/perl
#
# bump-perl-version, DAPM 14 Jul 2009
#
# A utility to find, and optionally bump, references to the perl version
# number in various files within the perl source
#
# It's designed to work in two phases. First, when run with -s (scan),
# it searches all the files in MANIFEST looking for strings that appear to
# match the current perl version (or which it knows are *supposed* to
# contain the current version), and produces a list of them to stdout,
# along with a suggested edit. For example:
#
#     $ Porting/bump-perl-version -s 5.10.0 5.10.1 > /tmp/scan
#     $ cat /tmp/scan
#     Porting/config.sh
#     
#     52: -archlib='/opt/perl/lib/5.10.0/i686-linux-64int'
#         +archlib='/opt/perl/lib/5.10.1/i686-linux-64int'
#     ....
#
# At this point there will be false positives. Edit the file to remove
# those changes you don't want made. Then in the second phase, feed that
# list in, and it will change those lines in the files:
#
#     $ Porting/bump-perl-version -u < /tmp/scan
#
# (so line 52 of Porting/config.sh is now updated)

# This utility 'knows' about certain files and formats, and so can spot
# 'hidden' version numbers, like PERL_SUBVERSION=9.
#
# A third variant makes use of this knowledge to check that all the things
# it knows about are at the current version:
#
#    $ Porting/bump-perl-version -c 5.10.0
#
# XXX this script hasn't been tested against a major version bump yet,
# eg 5.11.0 to 5.12.0; there may be things it missed - DAPM 14 Jul 09
#
# Note there are various files and directories that it skips; these are
# ones that are unlikely to contain anything needing bumping, but which
# will generate lots fo false positives (eg pod/*). These are listed on
# STDERR as they are skipped.

use strict;
use warnings;
use Getopt::Std;
use ExtUtils::Manifest;


sub usage { die <<EOF }

@_

usage: $0 -c <C.C.C>
          -s <C.C.C> <N.N.N>
	  -u

    -c check files and warn if any known string values (eg
	PERL_SUBVERSION) don't match the specified version

    -s scan files and produce list of possible change lines to stdout

    -u read in the scan file from stdin, and change all the lines specified

    C.C.C the current perl version, eg 5.10.0
    N.N.N the new     perl version, eg 5.10.1
EOF

my %opts;
getopts('csu', \%opts) or usage;
if ($opts{u}) {
    @ARGV == 0 or usage('no version version numbers should be speciied');
    # fake to stop warnings when calculating $oldx etc
    @ARGV = qw(99.99.99 99.99.99);
}
elsif ($opts{c}) {
    @ARGV == 1 or usage('required one version number');
    push @ARGV, $ARGV[0];
}
else {
    @ARGV == 2 or usage('require two version numbers');
}
usage('only one of -c, -s and -u') if keys %opts > 1;

my ($oldx, $oldy, $oldz) = $ARGV[0] =~ /^(\d+)\.(\d+)\.(\d+)$/
	or usage("bad version: $ARGV[0]");
my ($newx, $newy, $newz) = $ARGV[1] =~ /^(\d+)\.(\d+)\.(\d+)$/
	or usage("bad version: $ARGV[1]");

my $old_decimal = sprintf "%d.%03d%03d", $oldx, $oldy, $oldz; # 5.011001

# each entry is
#   0 a regexp that matches strings that might contain versions;
#   1 a sub that returns two strings based on $1 etc values:
#     * string containing captured values (for -c)
#     * a string containing the replacement value
#   2 what we expect the sub to return as its first arg; undef implies
#     don't match
#   3 a regex restricting which files this applies to (undef is all files)
#
# Note that @maps entries are checks in order, and only the first to match
# is used.

my @maps =  (
    [
	qr{^((?:api_)?version(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
	sub { $2, "$1$newy$3" },
	$oldy,
	qr/config/,
    ],
    [
	qr{^(subversion(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
	sub { $2, "$1$newz$3" },
	$oldz,
	qr/config/,
    ],
    [
	qr{^(api_subversion(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
	sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
	($oldy % 2) ? $oldz : 0,
	qr/config/,
    ],
    [
	qr{^(api_versionstring(?:=|\s+)'?) ([\d\.]+) ('?) (?!\.)}x,
	sub { $2, ($newy % 2) ? "$1$newx.$newy.$newz$3": "$1$newx.$newy.0$3" },
	($oldy % 2) ? "$oldx.$oldy.$oldz" : "$oldx.$oldy.0",
	qr/config/,
    ],
    [
	qr{(version\s+'?) (\d+) ('?\s+subversion\s+'?) (\d+) ('?)  (?!\.)}x,
	sub { "$2-$4", "$1$newy$3$newz$5" },
	"$oldy-$oldz",
	qr/config/,
    ],
    [
	qr{\b (PERL_(?:API_)?VERSION(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
	sub { $2, "$1$newy$3"},
	$oldy,
    ],
    [
	qr{\b (PERL_SUBVERSION(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
	sub { $2, "$1$newz$3"},
	($oldy % 2) ? $oldz : 0,
    ],
    [
	qr{\b (PERL_API_SUBVERSION(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
	sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
	$oldz,
    ],
    # these two formats are in README.vms
    [
	qr{\b perl-(\d+\^\.\d+\^\.\d+) \b}x,
	sub { $1, "perl-$newx^.$newy^.$newz"},
	undef,
    ],
    [
	qr{\b ($oldx _ $oldy _$oldz) \b}x,
	sub { $1, ($newx . '_' . $newy . '_' . $newz)},
	undef,
    ],
    # 5.8.9
    [
	qr{ $oldx\.$oldy\.$oldz \b}x,
	sub {"", "$newx.$newy.$newz"},
	undef,
    ],

    # 5.008009
    [
	qr{ $old_decimal \b}x,
	sub {"", sprintf "%d.%03d%03d", $newx, $newy, $newz },
	undef,
    ],

    # perl511, perl511.dll, perl511.lib, perl511s.lib, libperl511.a
    [
	qr{\b ((?:lib)?) perl (\d\d\d) (s?) \b }x,
	sub {$2, "$1perl$newx$newy$3" },
	"$oldx$oldy",
	qr/makedef|win32|hints/,      # makedef.pl, README.win32, win32/*, hints/*
    ],

);


# files and dirs that we likely don't want to change version numbers on.

my %SKIP_FILES = map { ($_ => 1) } qw(
    Changes
    MANIFEST
    Porting/epigraphs.pod
    Porting/how_to_write_a_perldelta.pod
    Porting/release_managers_guide.pod
    Porting/release_schedule.pod
    Porting/bump-perl-version
    pod.lst
    pp_ctl.c
);
my @SKIP_DIRS = qw(
    ext
    lib
    pod
    t
);

my @mani_files = sort keys %{ExtUtils::Manifest::maniread('MANIFEST')};
my %mani_files = map { ($_ => 1) } @mani_files;
die "No entries found in MANIFEST; aborting\n" unless @mani_files;

if ($opts{c} or $opts{s}) {
    do_scan();
}
elsif ($opts{u}) {
    do_update();
}
else {
    usage('one of -c, -s or -u must be specifcied');
}
exit 0;


sub do_scan {
    for my $file (@mani_files) {
	next if grep $file =~ m{$_/}, @SKIP_DIRS;
	if ($SKIP_FILES{$file}) {
	    warn "(skipping $file)\n";
	    next;
	}
	open my $fh, '<', $file or die "Aborting: can't open $file: $!\n";
	my $header = 0;

	while (<$fh>) {
	    for my $map (@maps) {
		my ($pat, $sub, $expected, $file_pat) = @$map;

		next if defined $file_pat and $file !~ $file_pat;
		next unless $_ =~ $pat;
		my ($got, $replacement) = $sub->();

		if ($opts{c}) {
		    # only report unexpected 
		    next unless defined $expected and $got ne $expected;
		}
		my $newstr = $_;
    		$newstr =~ s/$pat/$replacement/
		    or die "Internal error: substitution failed: [$pat]\n";
		if ($_ ne $newstr) {
		    print "\n$file\n" unless $header;
		    $header=1;
		    printf "\n%5d: -%s       +%s", $., $_, $newstr;
		}
		last;
	    }
	}
    }
    warn "(skipped  $_/*)\n" for @SKIP_DIRS;
}

sub do_update {

    my %changes;
    my $file;
    my $line;

    # read in config

    while (<STDIN>) {
	next unless /\S/;
	if (/^(\S+)$/) {
	    $file = $1;
	    die "No such file in MANIFEST: '$file'\n" unless $mani_files{$file};
	    die "file already seen; '$file'\n" if exists $changes{$file};
	    undef $line;
	}
	elsif (/^\s+(\d+): -(.*)/) {
	    my $old;
	    ($line, $old) = ($1,$2);
	    die "$.: old line without preceeding filename\n"
			    unless defined $file;
	    die "Dup line number: $line\n" if exists $changes{$file}{$line};
	    $changes{$file}{$line}[0] = $old;
	}
	elsif (/^\s+\+(.*)/) {
	    my $new = $1;
	    die "$.: replacement line seen without old line\n" unless $line;
	    $changes{$file}{$line}[1] = $new;
	    undef $line;
	}
	else {
	    die "Unexpected line at ;line $.: $_\n";
	}
    }

    # suck in file contents to memory, then update that in-memory copy

    my %contents;
    for my $file (sort keys %changes) {
	open my $fh, '<', $file or die "open '$file': $!\n";
	binmode $fh;
	$contents{$file} = [ <$fh> ];
	chomp @{$contents{$file}};
	close $fh or die "close: '$file': $!\n";

	my $entries = $changes{$file};
	for my $line (keys %$entries) {
	    die "$file: no such line: $line\n"
		    unless defined $contents{$file}[$line-1];
	    if ($contents{$file}[$line-1] ne $entries->{$line}[0]) {
		die "$file: line mismatch at line $line:\n"
			. "File:   [$contents{$file}[$line-1]]\n"
			. "Config: [$entries->{$line}[0]]\n"
	    }
	    $contents{$file}[$line-1] = $entries->{$line}[1];
	}
    }

    # check the temp files don't already exist

    for my $file (sort keys %contents) {
	my $nfile = "$file-new";
	die "$nfile already exists in MANIFEST; aborting\n"
	    if $mani_files{$nfile};
    }

    # write out the new files

    for my $file (sort keys %contents) {
	my $nfile = "$file-new";
	open my $fh, '>', $nfile or die "create '$nfile' failed: $!\n";
	binmode $fh;
	print $fh $_, "\n" for @{$contents{$file}};
	close $fh or die "failed to close $nfile; aborting: $!\n";

	my @stat = stat $file or die "Can't stat $file: $!\n";
	my $mode = $stat[2];
	die "stat $file fgailed to give a mode!\n" unless defined $mode;
	chmod $mode & 0777, $nfile or die "chmod $nfile failed; aborting: $!\n";
    }

    # and rename them

    for my $file (sort keys %contents) {
	my $nfile = "$file-new";
	warn "updating $file ...\n";
	rename $nfile, $file or die "rename $nfile $file: $!\n";
    }
}
Commit	Line	Data
ae1b7029 DM	1	#!/usr/bin/perl
	2	#
	3	# bump-perl-version, DAPM 14 Jul 2009
	4	#
	5	# A utility to find, and optionally bump, references to the perl version
	6	# number in various files within the perl source
	7	#
	8	# It's designed to work in two phases. First, when run with -s (scan),
	9	# it searches all the files in MANIFEST looking for strings that appear to
	10	# match the current perl version (or which it knows are supposed to
	11	# contain the current version), and produces a list of them to stdout,
	12	# along with a suggested edit. For example:
	13	#
	14	# $ Porting/bump-perl-version -s 5.10.0 5.10.1 > /tmp/scan
	15	# $ cat /tmp/scan
	16	# Porting/config.sh
	17	#
	18	# 52: -archlib='/opt/perl/lib/5.10.0/i686-linux-64int'
	19	# +archlib='/opt/perl/lib/5.10.1/i686-linux-64int'
	20	# ....
	21	#
	22	# At this point there will be false positives. Edit the file to remove
	23	# those changes you don't want made. Then in the second phase, feed that
	24	# list in, and it will change those lines in the files:
	25	#
	26	# $ Porting/bump-perl-version -u < /tmp/scan
	27	#
	28	# (so line 52 of Porting/config.sh is now updated)
	29
	30	# This utility 'knows' about certain files and formats, and so can spot
	31	# 'hidden' version numbers, like PERL_SUBVERSION=9.
	32	#
	33	# A third variant makes use of this knowledge to check that all the things
	34	# it knows about are at the current version:
	35	#
	36	# $ Porting/bump-perl-version -c 5.10.0
	37	#
	38	# XXX this script hasn't been tested against a major version bump yet,
	39	# eg 5.11.0 to 5.12.0; there may be things it missed - DAPM 14 Jul 09
	40	#
	41	# Note there are various files and directories that it skips; these are
	42	# ones that are unlikely to contain anything needing bumping, but which
	43	# will generate lots fo false positives (eg pod/*). These are listed on
	44	# STDERR as they are skipped.
	45
	46	use strict;
	47	use warnings;
	48	use Getopt::Std;
	49	use ExtUtils::Manifest;
	50
	51
	52	sub usage { die <<EOF }
	53
	54	@_
	55
	56	usage: $0 -c <C.C.C>
	57	-s <C.C.C> <N.N.N>
	58	-u
	59
	60	-c check files and warn if any known string values (eg
	61	PERL_SUBVERSION) don't match the specified version
	62
	63	-s scan files and produce list of possible change lines to stdout
	64
65	-u read in the scan file from stdin, and change all the lines specified
66
67	C.C.C the current perl version, eg 5.10.0
68	N.N.N the new perl version, eg 5.10.1
69	EOF
70
71	my %opts;
72	getopts('csu', \%opts) or usage;
73	if ($opts{u}) {
74	@ARGV == 0 or usage('no version version numbers should be speciied');
75	# fake to stop warnings when calculating $oldx etc
76	@ARGV = qw(99.99.99 99.99.99);
77	}
78	elsif ($opts{c}) {
79	@ARGV == 1 or usage('required one version number');
80	push @ARGV, $ARGV[0];
81	}
82	else {
83	@ARGV == 2 or usage('require two version numbers');
84	}
85	usage('only one of -c, -s and -u') if keys %opts > 1;
86
87	my ($oldx, $oldy, $oldz) = $ARGV[0] =~ /^(\d+)\.(\d+)\.(\d+)$/
88	or usage("bad version: $ARGV[0]");
89	my ($newx, $newy, $newz) = $ARGV[1] =~ /^(\d+)\.(\d+)\.(\d+)$/
90	or usage("bad version: $ARGV[1]");
91
92	my $old_decimal = sprintf "%d.%03d%03d", $oldx, $oldy, $oldz; # 5.011001
93
94	# each entry is
95	# 0 a regexp that matches strings that might contain versions;
96	# 1 a sub that returns two strings based on $1 etc values:
97	# * string containing captured values (for -c)
98	# * a string containing the replacement value
99	# 2 what we expect the sub to return as its first arg; undef implies
100	# don't match
101	# 3 a regex restricting which files this applies to (undef is all files)
102	#
103	# Note that @maps entries are checks in order, and only the first to match
104	# is used.
105
106	my @maps = (
107	[
108	qr{^((?:api_)?version(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
109	sub { $2, "$1$newy$3" },
110	$oldy,
111	qr/config/,
112	],
113	[
114	qr{^(subversion(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
115	sub { $2, "$1$newz$3" },
116	$oldz,
117	qr/config/,
118	],
119	[
120	qr{^(api_subversion(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
544af516 FR	121	sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
544af516 FR	122	($oldy % 2) ? $oldz : 0,
ae1b7029 DM	123	qr/config/,
	124	],
	125	[
	126	qr{^(api_versionstring(?:=\|\s+)'?) ([\d\.]+) ('?) (?!\.)}x,
544af516 FR	127	sub { $2, ($newy % 2) ? "$1$newx.$newy.$newz$3": "$1$newx.$newy.0$3" },
544af516 FR	128	($oldy % 2) ? "$oldx.$oldy.$oldz" : "$oldx.$oldy.0",
ae1b7029 DM	129	qr/config/,
	130	],
	131	[
	132	qr{(version\s+'?) (\d+) ('?\s+subversion\s+'?) (\d+) ('?) (?!\.)}x,
	133	sub { "$2-$4", "$1$newy$3$newz$5" },
	134	"$oldy-$oldz",
	135	qr/config/,
	136	],
	137	[
	138	qr{\b (PERL_(?:API_)?VERSION(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
	139	sub { $2, "$1$newy$3"},
	140	$oldy,
	141	],
	142	[
	143	qr{\b (PERL_SUBVERSION(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
	144	sub { $2, "$1$newz$3"},
544af516	145	($oldy % 2) ? $oldz : 0,
ae1b7029 DM	146	],
	147	[
	148	qr{\b (PERL_API_SUBVERSION(?:=\|\s+)'?) (\d+) ('?) (?!\.)}x,
544af516 FR	149	sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
544af516 FR	150	$oldz,
ae1b7029 DM	151	],
	152	# these two formats are in README.vms
	153	[
	154	qr{\b perl-(\d+\^\.\d+\^\.\d+) \b}x,
	155	sub { $1, "perl-$newx^.$newy^.$newz"},
	156	undef,
	157	],
	158	[
	159	qr{\b ($oldx _ $oldy _$oldz) \b}x,
	160	sub { $1, ($newx . '_' . $newy . '_' . $newz)},
	161	undef,
	162	],
	163	# 5.8.9
	164	[
8b8cdb3a	165	qr{ $oldx\.$oldy\.$oldz \b}x,
ae1b7029 DM	166	sub {"", "$newx.$newy.$newz"},
	167	undef,
	168	],
	169
	170	# 5.008009
	171	[
8b8cdb3a	172	qr{ $old_decimal \b}x,
ae1b7029 DM	173	sub {"", sprintf "%d.%03d%03d", $newx, $newy, $newz },
	174	undef,
	175	],
	176
d4f05c0b	177	# perl511, perl511.dll, perl511.lib, perl511s.lib, libperl511.a
7dfca73b	178	[
d4f05c0b VP	179	qr{\b ((?:lib)?) perl (\d\d\d) (s?) \b }x,
d4f05c0b VP	180	sub {$2, "$1perl$newx$newy$3" },
7dfca73b	181	"$oldx$oldy",
d4f05c0b	182	qr/makedef\|win32\|hints/, # makedef.pl, README.win32, win32/, hints/
7dfca73b JD	183	],
7dfca73b JD	184
ae1b7029 DM	185	);
	186
	187
	188	# files and dirs that we likely don't want to change version numbers on.
	189
	190	my %SKIP_FILES = map { ($_ => 1) } qw(
	191	Changes
	192	MANIFEST
87f4ab41	193	Porting/epigraphs.pod
ae1b7029	194	Porting/how_to_write_a_perldelta.pod
5bd03515	195	Porting/release_managers_guide.pod
87f4ab41	196	Porting/release_schedule.pod
8b8cdb3a	197	Porting/bump-perl-version
ae1b7029	198	pod.lst
5bd03515	199	pp_ctl.c
ae1b7029 DM	200	);
	201	my @SKIP_DIRS = qw(
	202	ext
	203	lib
	204	pod
	205	t
	206	);
	207
	208	my @mani_files = sort keys %{ExtUtils::Manifest::maniread('MANIFEST')};
	209	my %mani_files = map { ($_ => 1) } @mani_files;
	210	die "No entries found in MANIFEST; aborting\n" unless @mani_files;
	211
	212	if ($opts{c} or $opts{s}) {
	213	do_scan();
	214	}
	215	elsif ($opts{u}) {
	216	do_update();
	217	}
	218	else {
	219	usage('one of -c, -s or -u must be specifcied');
	220	}
	221	exit 0;
	222
	223
	224
	225
	226	sub do_scan {
	227	for my $file (@mani_files) {
	228	next if grep $file =~ m{$_/}, @SKIP_DIRS;
	229	if ($SKIP_FILES{$file}) {
	230	warn "(skipping $file)\n";
	231	next;
	232	}
	233	open my $fh, '<', $file or die "Aborting: can't open $file: $!\n";
	234	my $header = 0;
	235
	236	while (<$fh>) {
	237	for my $map (@maps) {
	238	my ($pat, $sub, $expected, $file_pat) = @$map;
	239
	240	next if defined $file_pat and $file !~ $file_pat;
	241	next unless $_ =~ $pat;
	242	my ($got, $replacement) = $sub->();
	243
	244	if ($opts{c}) {
	245	# only report unexpected
	246	next unless defined $expected and $got ne $expected;
	247	}
	248	my $newstr = $_;
	249	$newstr =~ s/$pat/$replacement/
	250	or die "Internal error: substitution failed: [$pat]\n";
	251	if ($_ ne $newstr) {
	252	print "\n$file\n" unless $header;
	253	$header=1;
	254	printf "\n%5d: -%s +%s", $., $_, $newstr;
	255	}
	256	last;
	257	}
	258	}
	259	}
	260	warn "(skipped $_/*)\n" for @SKIP_DIRS;
	261	}
	262
	263	sub do_update {
264
265	my %changes;
266	my $file;
267	my $line;
268
269	# read in config
270
271	while (<STDIN>) {
272	next unless /\S/;
273	if (/^(\S+)$/) {
274	$file = $1;
275	die "No such file in MANIFEST: '$file'\n" unless $mani_files{$file};
276	die "file already seen; '$file'\n" if exists $changes{$file};
277	undef $line;
278	}
279	elsif (/^\s+(\d+): -(.*)/) {
280	my $old;
281	($line, $old) = ($1,$2);
282	die "$.: old line without preceeding filename\n"
283	unless defined $file;
284	die "Dup line number: $line\n" if exists $changes{$file}{$line};
285	$changes{$file}{$line}[0] = $old;
286	}
287	elsif (/^\s+\+(.*)/) {
288	my $new = $1;
289	die "$.: replacement line seen without old line\n" unless $line;
290	$changes{$file}{$line}[1] = $new;
291	undef $line;
292	}
293	else {
294	die "Unexpected line at ;line $.: $_\n";
295	}
296	}
297
298	# suck in file contents to memory, then update that in-memory copy
299
300	my %contents;
301	for my $file (sort keys %changes) {
302	open my $fh, '<', $file or die "open '$file': $!\n";
33c1015f	303	binmode $fh;
ae1b7029 DM	304	$contents{$file} = [ <$fh> ];
	305	chomp @{$contents{$file}};
	306	close $fh or die "close: '$file': $!\n";
	307
	308	my $entries = $changes{$file};
	309	for my $line (keys %$entries) {
	310	die "$file: no such line: $line\n"
	311	unless defined $contents{$file}[$line-1];
	312	if ($contents{$file}[$line-1] ne $entries->{$line}[0]) {
	313	die "$file: line mismatch at line $line:\n"
	314	. "File: [$contents{$file}[$line-1]]\n"
	315	. "Config: [$entries->{$line}[0]]\n"
	316	}
	317	$contents{$file}[$line-1] = $entries->{$line}[1];
	318	}
	319	}
	320
	321	# check the temp files don't already exist
	322
	323	for my $file (sort keys %contents) {
	324	my $nfile = "$file-new";
	325	die "$nfile already exists in MANIFEST; aborting\n"
	326	if $mani_files{$nfile};
	327	}
	328
	329	# write out the new files
	330
	331	for my $file (sort keys %contents) {
	332	my $nfile = "$file-new";
	333	open my $fh, '>', $nfile or die "create '$nfile' failed: $!\n";
33c1015f	334	binmode $fh;
ae1b7029 DM	335	print $fh $_, "\n" for @{$contents{$file}};
	336	close $fh or die "failed to close $nfile; aborting: $!\n";
	337
	338	my @stat = stat $file or die "Can't stat $file: $!\n";
	339	my $mode = $stat[2];
	340	die "stat $file fgailed to give a mode!\n" unless defined $mode;
	341	chmod $mode & 0777, $nfile or die "chmod $nfile failed; aborting: $!\n";
	342	}
	343
	344	# and rename them
	345
	346	for my $file (sort keys %contents) {
	347	my $nfile = "$file-new";
	348	warn "updating $file ...\n";
	349	rename $nfile, $file or die "rename $nfile $file: $!\n";
	350	}
	351	}
	352