[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)
#
# The -i option can be used to combine these two steps (if you prefer to make
# all of the changes at once and then edit the results via git).

# 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 autodie;
use Getopt::Std;
use ExtUtils::Manifest;


sub usage { die <<EOF }

@_

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

    -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

    -i scan files and make changes inplace

    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('csui', \%opts) or usage;
if ($opts{u}) {
    @ARGV == 0 or usage('no version version numbers should be specified');
    # 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, -u and -i') 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/win32|hints/,      # README.win32, win32/*, hints/*
    ],

    # microperl locations should be bumped for major versions
    [
        qr{(/)(\d\.\d{2})(["'/])},
        sub { $2, "$1$newx.$newy$3" },
        "$oldx.$oldy",
        qr/uconfig/,
    ],

    # rename perl-5^.15^.1.dirperl-5_15_1.dir in README.vms
    [
	qr{\sperl-(\d+)_(\d+)_(\d+)\.dir}x,
	sub { " perl-${1}_${2}_${3}.dir", " perl-${newx}_${newy}_${newz}.dir" },
	" perl-${oldx}_${oldy}_{$oldz}.dir",
	qr/README.vms/,
    ],

);


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

my %SKIP_FILES = map { ($_ => 1) } qw(
    Changes
    MANIFEST
    Porting/Maintainers.pl
    Porting/acknowledgements.pl
    Porting/epigraphs.pod
    Porting/how_to_write_a_perldelta.pod
    Porting/release_managers_guide.pod
    Porting/release_schedule.pod
    Porting/bump-perl-version
    pp_ctl.c
);
my @SKIP_DIRS = qw(
    ext
    lib
    pod
    cpan
    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} or $opts{i}) {
    do_scan();
}
elsif ($opts{u}) {
    do_update();
}
else {
    usage('one of -c, -s or -u must be specified');
}
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;
	my $header = 0;
	my @stat = stat $file;
	my $mode = $stat[2];
	my $file_changed = 0;
	my $new_contents = '';

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

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

		if ($opts{c}) {
		    # only report unexpected 
		    next unless defined $expected and $got ne $expected;
		}
		$line =~ s/$pat/$replacement/
		    or die "Internal error: substitution failed: [$pat]\n";
	    }
	    $new_contents .= $line if $opts{i};
	    if ($line ne $oldline) {
		$file_changed = 1;
		if ($opts{s}) {
		    print "\n$file\n" unless $header;
		    $header=1;
		    printf "\n%5d: -%s       +%s", $., $oldline, $line;
		}
	    }
	}
	if ($opts{i} && $file_changed) {
	    warn "Updating $file inplace\n";
	    open my $fh, '>', $file;
	    binmode $fh;
	    print $fh $new_contents;
	    close $fh;
	    chmod $mode & 0777, $file;
	}
    }
    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 preceding 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;
	binmode $fh;
	$contents{$file} = [ <$fh> ];
	chomp @{$contents{$file}};
	close $fh;

	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;
	binmode $fh;
	print $fh $_, "\n" for @{$contents{$file}};
	close $fh;

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

    # and rename them

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