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