3 # bump-perl-version, DAPM 14 Jul 2009
5 # A utility to find, and optionally bump, references to the perl version
6 # number in various files within the perl source
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:
14 # $ Porting/bump-perl-version -s 5.10.0 5.10.1 > /tmp/scan
18 # 52: -archlib='/opt/perl/lib/5.10.0/i686-linux-64int'
19 # +archlib='/opt/perl/lib/5.10.1/i686-linux-64int'
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:
26 # $ Porting/bump-perl-version -u < /tmp/scan
28 # (so line 52 of Porting/config.sh is now updated)
30 # This utility 'knows' about certain files and formats, and so can spot
31 # 'hidden' version numbers, like PERL_SUBVERSION=9.
33 # A third variant makes use of this knowledge to check that all the things
34 # it knows about are at the current version:
36 # $ Porting/bump-perl-version -c 5.10.0
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
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.
49 use ExtUtils::Manifest;
52 sub usage { die <<EOF }
60 -c check files and warn if any known string values (eg
61 PERL_SUBVERSION) don't match the specified version
63 -s scan files and produce list of possible change lines to stdout
65 -u read in the scan file from stdin, and change all the lines specified
67 C.C.C the current perl version, eg 5.10.0
68 N.N.N the new perl version, eg 5.10.1
72 getopts('csu', \%opts) or usage;
74 @ARGV == 0 or usage('no version version numbers should be specified');
75 # fake to stop warnings when calculating $oldx etc
76 @ARGV = qw(99.99.99 99.99.99);
79 @ARGV == 1 or usage('required one version number');
83 @ARGV == 2 or usage('require two version numbers');
85 usage('only one of -c, -s and -u') if keys %opts > 1;
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]");
92 my $old_decimal = sprintf "%d.%03d%03d", $oldx, $oldy, $oldz; # 5.011001
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
101 # 3 a regex restricting which files this applies to (undef is all files)
103 # Note that @maps entries are checks in order, and only the first to match
108 qr{^((?:api_)?version(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
109 sub { $2, "$1$newy$3" },
114 qr{^(subversion(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
115 sub { $2, "$1$newz$3" },
120 qr{^(api_subversion(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
121 sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
122 ($oldy % 2) ? $oldz : 0,
126 qr{^(api_versionstring(?:=|\s+)'?) ([\d\.]+) ('?) (?!\.)}x,
127 sub { $2, ($newy % 2) ? "$1$newx.$newy.$newz$3": "$1$newx.$newy.0$3" },
128 ($oldy % 2) ? "$oldx.$oldy.$oldz" : "$oldx.$oldy.0",
132 qr{(version\s+'?) (\d+) ('?\s+subversion\s+'?) (\d+) ('?) (?!\.)}x,
133 sub { "$2-$4", "$1$newy$3$newz$5" },
138 qr{\b (PERL_(?:API_)?VERSION(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
139 sub { $2, "$1$newy$3"},
143 qr{\b (PERL_SUBVERSION(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
144 sub { $2, "$1$newz$3"},
145 ($oldy % 2) ? $oldz : 0,
148 qr{\b (PERL_API_SUBVERSION(?:=|\s+)'?) (\d+) ('?) (?!\.)}x,
149 sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
152 # these two formats are in README.vms
154 qr{\b perl-(\d+\^\.\d+\^\.\d+) \b}x,
155 sub { $1, "perl-$newx^.$newy^.$newz"},
159 qr{\b ($oldx _ $oldy _$oldz) \b}x,
160 sub { $1, ($newx . '_' . $newy . '_' . $newz)},
165 qr{ $oldx\.$oldy\.$oldz \b}x,
166 sub {"", "$newx.$newy.$newz"},
172 qr{ $old_decimal \b}x,
173 sub {"", sprintf "%d.%03d%03d", $newx, $newy, $newz },
177 # perl511, perl511.dll, perl511.lib, perl511s.lib, libperl511.a
179 qr{\b ((?:lib)?) perl (\d\d\d) (s?) \b }x,
180 sub {$2, "$1perl$newx$newy$3" },
182 qr/makedef|win32|hints/, # makedef.pl, README.win32, win32/*, hints/*
185 # microperl locations should be bumped for major versions
187 qr{(/)(\d\.\d{2})(["'/])},
188 sub { $2, "$1$newx.$newy$3" },
196 # files and dirs that we likely don't want to change version numbers on.
198 my %SKIP_FILES = map { ($_ => 1) } qw(
201 Porting/epigraphs.pod
202 Porting/how_to_write_a_perldelta.pod
203 Porting/release_managers_guide.pod
204 Porting/release_schedule.pod
205 Porting/bump-perl-version
217 my @mani_files = sort keys %{ExtUtils::Manifest::maniread('MANIFEST')};
218 my %mani_files = map { ($_ => 1) } @mani_files;
219 die "No entries found in MANIFEST; aborting\n" unless @mani_files;
221 if ($opts{c} or $opts{s}) {
228 usage('one of -c, -s or -u must be specified');
236 for my $file (@mani_files) {
237 next if grep $file =~ m{$_/}, @SKIP_DIRS;
238 if ($SKIP_FILES{$file}) {
239 warn "(skipping $file)\n";
242 open my $fh, '<', $file or die "Aborting: can't open $file: $!\n";
246 for my $map (@maps) {
247 my ($pat, $sub, $expected, $file_pat) = @$map;
249 next if defined $file_pat and $file !~ $file_pat;
250 next unless $_ =~ $pat;
251 my ($got, $replacement) = $sub->();
254 # only report unexpected
255 next unless defined $expected and $got ne $expected;
258 $newstr =~ s/$pat/$replacement/
259 or die "Internal error: substitution failed: [$pat]\n";
261 print "\n$file\n" unless $header;
263 printf "\n%5d: -%s +%s", $., $_, $newstr;
269 warn "(skipped $_/*)\n" for @SKIP_DIRS;
284 die "No such file in MANIFEST: '$file'\n" unless $mani_files{$file};
285 die "file already seen; '$file'\n" if exists $changes{$file};
288 elsif (/^\s+(\d+): -(.*)/) {
290 ($line, $old) = ($1,$2);
291 die "$.: old line without preceding filename\n"
292 unless defined $file;
293 die "Dup line number: $line\n" if exists $changes{$file}{$line};
294 $changes{$file}{$line}[0] = $old;
296 elsif (/^\s+\+(.*)/) {
298 die "$.: replacement line seen without old line\n" unless $line;
299 $changes{$file}{$line}[1] = $new;
303 die "Unexpected line at ;line $.: $_\n";
307 # suck in file contents to memory, then update that in-memory copy
310 for my $file (sort keys %changes) {
311 open my $fh, '<', $file or die "open '$file': $!\n";
313 $contents{$file} = [ <$fh> ];
314 chomp @{$contents{$file}};
315 close $fh or die "close: '$file': $!\n";
317 my $entries = $changes{$file};
318 for my $line (keys %$entries) {
319 die "$file: no such line: $line\n"
320 unless defined $contents{$file}[$line-1];
321 if ($contents{$file}[$line-1] ne $entries->{$line}[0]) {
322 die "$file: line mismatch at line $line:\n"
323 . "File: [$contents{$file}[$line-1]]\n"
324 . "Config: [$entries->{$line}[0]]\n"
326 $contents{$file}[$line-1] = $entries->{$line}[1];
330 # check the temp files don't already exist
332 for my $file (sort keys %contents) {
333 my $nfile = "$file-new";
334 die "$nfile already exists in MANIFEST; aborting\n"
335 if $mani_files{$nfile};
338 # write out the new files
340 for my $file (sort keys %contents) {
341 my $nfile = "$file-new";
342 open my $fh, '>', $nfile or die "create '$nfile' failed: $!\n";
344 print $fh $_, "\n" for @{$contents{$file}};
345 close $fh or die "failed to close $nfile; aborting: $!\n";
347 my @stat = stat $file or die "Can't stat $file: $!\n";
349 die "stat $file fgailed to give a mode!\n" unless defined $mode;
350 chmod $mode & 0777, $nfile or die "chmod $nfile failed; aborting: $!\n";
355 for my $file (sort keys %contents) {
356 my $nfile = "$file-new";
357 warn "updating $file ...\n";
358 rename $nfile, $file or die "rename $nfile $file: $!\n";