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# 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). 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 49use strict; 50use warnings; 51use autodie; 52use Getopt::Std; 53use ExtUtils::Manifest; 54 55 56sub usage { die <<EOF } 57 58@_ 59 60usage: $0 -c <C.C.C> 61 -s <C.C.C> <N.N.N> 62 -u 63 -i <C.C.C> <N.N.N> 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 72 -i scan files and make changes inplace 73 74 C.C.C the current perl version, eg 5.10.0 75 N.N.N the new perl version, eg 5.10.1 76EOF 77 78my %opts; 79getopts('csui', \%opts) or usage; 80if ($opts{u}) { 81 @ARGV == 0 or usage('no version version numbers should be specified'); 82 # fake to stop warnings when calculating $oldx etc 83 @ARGV = qw(99.99.99 99.99.99); 84} 85elsif ($opts{c}) { 86 @ARGV == 1 or usage('required one version number'); 87 push @ARGV, $ARGV[0]; 88} 89else { 90 @ARGV == 2 or usage('require two version numbers'); 91} 92usage('only one of -c, -s, -u and -i') if keys %opts > 1; 93 94my ($oldx, $oldy, $oldz) = $ARGV[0] =~ /^(\d+)\.(\d+)\.(\d+)$/ 95 or usage("bad version: $ARGV[0]"); 96my ($newx, $newy, $newz) = $ARGV[1] =~ /^(\d+)\.(\d+)\.(\d+)$/ 97 or usage("bad version: $ARGV[1]"); 98 99my $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 113my @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, 128 sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" }, 129 ($oldy % 2) ? $oldz : 0, 130 qr/config/, 131 ], 132 [ 133 qr{^(api_versionstring(?:=|\s+)'?) ([\d\.]+) ('?) (?!\.)}x, 134 sub { $2, ($newy % 2) ? "$1$newx.$newy.$newz$3": "$1$newx.$newy.0$3" }, 135 ($oldy % 2) ? "$oldx.$oldy.$oldz" : "$oldx.$oldy.0", 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"}, 152 ($oldy % 2) ? $oldz : 0, 153 ], 154 [ 155 qr{\b (PERL_API_SUBVERSION(?:=|\s+)'?) (\d+) ('?) (?!\.)}x, 156 sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" }, 157 $oldz, 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 [ 172 qr{ $oldx\.$oldy\.$oldz \b}x, 173 sub {"", "$newx.$newy.$newz"}, 174 undef, 175 ], 176 177 # 5.008009 178 [ 179 qr{ $old_decimal \b}x, 180 sub {"", sprintf "%d.%03d%03d", $newx, $newy, $newz }, 181 undef, 182 ], 183 184 # perl511, perl511.dll, perl511.lib, perl511s.lib, libperl511.a 185 [ 186 qr{\b ((?:lib)?) perl (\d\d\d) (s?) \b }x, 187 sub {$2, "$1perl$newx$newy$3" }, 188 "$oldx$oldy", 189 qr/win32|hints/, # README.win32, win32/*, hints/* 190 ], 191 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 200); 201 202 203# files and dirs that we likely don't want to change version numbers on. 204 205my %SKIP_FILES = map { ($_ => 1) } qw( 206 Changes 207 MANIFEST 208 Porting/Maintainers.pl 209 Porting/acknowledgements.pl 210 Porting/corelist-perldelta.pl 211 Porting/epigraphs.pod 212 Porting/how_to_write_a_perldelta.pod 213 Porting/release_managers_guide.pod 214 Porting/release_schedule.pod 215 Porting/bump-perl-version 216 pp_ctl.c 217); 218my @SKIP_DIRS = qw( 219 ext 220 lib 221 pod 222 cpan 223 t 224); 225 226my @mani_files = sort keys %{ExtUtils::Manifest::maniread('MANIFEST')}; 227my %mani_files = map { ($_ => 1) } @mani_files; 228die "No entries found in MANIFEST; aborting\n" unless @mani_files; 229 230if ($opts{c} or $opts{s} or $opts{i}) { 231 do_scan(); 232} 233elsif ($opts{u}) { 234 do_update(); 235} 236else { 237 usage('one of -c, -s or -u must be specified'); 238} 239exit 0; 240 241 242 243 244sub do_scan { 245 for my $file (@mani_files) { 246 next if grep $file =~ m{$_/}, @SKIP_DIRS; 247 if ($SKIP_FILES{$file}) { 248 warn "(skipping $file)\n"; 249 next; 250 } 251 open my $fh, '<', $file; 252 my $header = 0; 253 my @stat = stat $file; 254 my $mode = $stat[2]; 255 my $file_changed = 0; 256 my $new_contents = ''; 257 258 while (my $line = <$fh>) { 259 my $oldline = $line; 260 for my $map (@maps) { 261 my ($pat, $sub, $expected, $file_pat) = @$map; 262 263 next if defined $file_pat and $file !~ $file_pat; 264 next unless $line =~ $pat; 265 my ($got, $replacement) = $sub->(); 266 267 if ($opts{c}) { 268 # only report unexpected 269 next unless defined $expected and $got ne $expected; 270 } 271 $line =~ s/$pat/$replacement/ 272 or die "Internal error: substitution failed: [$pat]\n"; 273 } 274 $new_contents .= $line if $opts{i}; 275 if ($line ne $oldline) { 276 $file_changed = 1; 277 if ($opts{s}) { 278 print "\n$file\n" unless $header; 279 $header=1; 280 printf "\n%5d: -%s +%s", $., $oldline, $line; 281 } 282 } 283 } 284 if ($opts{i} && $file_changed) { 285 warn "Updating $file inplace\n"; 286 open my $fh, '>', $file; 287 binmode $fh; 288 print $fh $new_contents; 289 close $fh; 290 chmod $mode & 0777, $file; 291 } 292 } 293 warn "(skipped $_/*)\n" for @SKIP_DIRS; 294} 295 296sub do_update { 297 298 my %changes; 299 my $file; 300 my $line; 301 302 # read in config 303 304 while (<STDIN>) { 305 next unless /\S/; 306 if (/^(\S+)$/) { 307 $file = $1; 308 die "No such file in MANIFEST: '$file'\n" unless $mani_files{$file}; 309 die "file already seen; '$file'\n" if exists $changes{$file}; 310 undef $line; 311 } 312 elsif (/^\s+(\d+): -(.*)/) { 313 my $old; 314 ($line, $old) = ($1,$2); 315 die "$.: old line without preceding filename\n" 316 unless defined $file; 317 die "Dup line number: $line\n" if exists $changes{$file}{$line}; 318 $changes{$file}{$line}[0] = $old; 319 } 320 elsif (/^\s+\+(.*)/) { 321 my $new = $1; 322 die "$.: replacement line seen without old line\n" unless $line; 323 $changes{$file}{$line}[1] = $new; 324 undef $line; 325 } 326 else { 327 die "Unexpected line at ;line $.: $_\n"; 328 } 329 } 330 331 # suck in file contents to memory, then update that in-memory copy 332 333 my %contents; 334 for my $file (sort keys %changes) { 335 open my $fh, '<', $file; 336 binmode $fh; 337 $contents{$file} = [ <$fh> ]; 338 chomp @{$contents{$file}}; 339 close $fh; 340 341 my $entries = $changes{$file}; 342 for my $line (keys %$entries) { 343 die "$file: no such line: $line\n" 344 unless defined $contents{$file}[$line-1]; 345 if ($contents{$file}[$line-1] ne $entries->{$line}[0]) { 346 die "$file: line mismatch at line $line:\n" 347 . "File: [$contents{$file}[$line-1]]\n" 348 . "Config: [$entries->{$line}[0]]\n" 349 } 350 $contents{$file}[$line-1] = $entries->{$line}[1]; 351 } 352 } 353 354 # check the temp files don't already exist 355 356 for my $file (sort keys %contents) { 357 my $nfile = "$file-new"; 358 die "$nfile already exists in MANIFEST; aborting\n" 359 if $mani_files{$nfile}; 360 } 361 362 # write out the new files 363 364 for my $file (sort keys %contents) { 365 my $nfile = "$file-new"; 366 open my $fh, '>', $nfile; 367 binmode $fh; 368 print $fh $_, "\n" for @{$contents{$file}}; 369 close $fh; 370 371 my @stat = stat $file; 372 my $mode = $stat[2]; 373 die "stat $file fgailed to give a mode!\n" unless defined $mode; 374 chmod $mode & 0777, $nfile; 375 } 376 377 # and rename them 378 379 for my $file (sort keys %contents) { 380 my $nfile = "$file-new"; 381 warn "updating $file ...\n"; 382 rename $nfile, $file; 383 } 384} 385 386