This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Create inversion list for Assigned code points
[perl5.git] / Porting / bump-perl-version
old mode 100755 (executable)
new mode 100644 (file)
index 75136ac..17ac966
@@ -26,6 +26,9 @@
 #     $ 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.
 #
 # 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
+# will generate lots of 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;
 
@@ -56,6 +60,7 @@ 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
@@ -64,14 +69,16 @@ usage: $0 -c <C.C.C>
 
     -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('csu', \%opts) or usage;
+getopts('csui', \%opts) or usage;
 if ($opts{u}) {
-    @ARGV == 0 or usage('no version version numbers should be speciied');
+    @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);
 }
@@ -82,7 +89,7 @@ elsif ($opts{c}) {
 else {
     @ARGV == 2 or usage('require two version numbers');
 }
-usage('only one of -c, -s and -u') if keys %opts > 1;
+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]");
@@ -118,14 +125,14 @@ my @maps =  (
     ],
     [
        qr{^(api_subversion(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
-       sub { $2, "${1}0$3" },
-       0,
+       sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
+       ($oldy % 2) ? $oldz : 0,
        qr/config/,
     ],
     [
        qr{^(api_versionstring(?:=|\s+)'?) ([\d\.]+) ('?) (?!\.)}x,
-       sub { $2, "$1$newx.$newy.0$3" },
-       "$oldx.$oldy.0",
+       sub { $2, ($newy % 2) ? "$1$newx.$newy.$newz$3": "$1$newx.$newy.0$3" },
+       ($oldy % 2) ? "$oldx.$oldy.$oldz" : "$oldx.$oldy.0",
        qr/config/,
     ],
     [
@@ -142,12 +149,12 @@ my @maps =  (
     [
        qr{\b (PERL_SUBVERSION(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
        sub { $2, "$1$newz$3"},
-       $oldz,
+       ($oldy % 2) ? $oldz : 0,
     ],
     [
        qr{\b (PERL_API_SUBVERSION(?:=|\s+)'?) (\d+) ('?)  (?!\.)}x,
-       sub { $2, "${1}0$3"},
-       0,
+       sub { $2, ($newy % 2) ? "$1$newz$3" : "${1}0$3" },
+       $oldz,
     ],
     # these two formats are in README.vms
     [
@@ -174,6 +181,29 @@ my @maps =  (
        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/,
+    ],
+
+    # win32/Makefile.ce
+    [
+        qr/(PV\s*=\s*)(\d\d{2})\b$/,
+        sub { $2, "$1$newx$newy" },
+        "$oldx$oldy",
+        qr/Makefile\.ce/,
+    ],
 );
 
 
@@ -181,19 +211,24 @@ my @maps =  (
 
 my %SKIP_FILES = map { ($_ => 1) } qw(
     Changes
+    intrpvar.h
     MANIFEST
+    Porting/Maintainers.pl
+    Porting/acknowledgements.pl
+    Porting/corelist-perldelta.pl
+    Porting/epigraphs.pod
     Porting/how_to_write_a_perldelta.pod
     Porting/release_managers_guide.pod
+    Porting/release_schedule.pod
     Porting/bump-perl-version
-    Porting/mergelog
-    Porting/mergelog-tool
-    pod.lst
     pp_ctl.c
 );
 my @SKIP_DIRS = qw(
+    dist
     ext
     lib
     pod
+    cpan
     t
 );
 
@@ -201,14 +236,14 @@ 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}) {
+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 specifcied');
+    usage('one of -c, -s or -u must be specified');
 }
 exit 0;
 
@@ -217,37 +252,57 @@ exit 0;
 
 sub do_scan {
     for my $file (@mani_files) {
-       next if grep $file =~ m{$_/}, @SKIP_DIRS;
+       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";
+       open my $fh, '<', $file;
        my $header = 0;
+       my @stat = stat $file;
+       my $mode = $stat[2];
+       my $file_changed = 0;
+       my $new_contents = '';
 
-       while (<$fh>) {
+       while (my $line = <$fh>) {
+           my $oldline = $line;
+           my $line_changed = 0;
            for my $map (@maps) {
                my ($pat, $sub, $expected, $file_pat) = @$map;
 
                next if defined $file_pat and $file !~ $file_pat;
-               next unless $_ =~ $pat;
+               next unless $line =~ $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/
+               $line =~ s/$pat/$replacement/
                    or die "Internal error: substitution failed: [$pat]\n";
-               if ($_ ne $newstr) {
+               if ($line ne $oldline) {
+                   $line_changed = 1;
+                   last;
+               }
+           }
+           $new_contents .= $line if $opts{i};
+           if ($line_changed) {
+               $file_changed = 1;
+               if ($opts{s}) {
                    print "\n$file\n" unless $header;
                    $header=1;
-                   printf "\n%5d: -%s       +%s", $., $_, $newstr;
+                   printf "\n%5d: -%s       +%s", $., $oldline, $line;
                }
-               last;
            }
        }
+       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;
 }
@@ -271,7 +326,7 @@ sub do_update {
        elsif (/^\s+(\d+): -(.*)/) {
            my $old;
            ($line, $old) = ($1,$2);
-           die "$.: old line without preceeding filename\n"
+           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;
@@ -291,10 +346,11 @@ sub do_update {
 
     my %contents;
     for my $file (sort keys %changes) {
-       open my $fh, '<', $file or die "open '$file': $!\n";
+       open my $fh, '<', $file;
+       binmode $fh;
        $contents{$file} = [ <$fh> ];
        chomp @{$contents{$file}};
-       close $fh or die "close: '$file': $!\n";
+       close $fh;
 
        my $entries = $changes{$file};
        for my $line (keys %$entries) {
@@ -321,14 +377,15 @@ sub do_update {
 
     for my $file (sort keys %contents) {
        my $nfile = "$file-new";
-       open my $fh, '>', $nfile or die "create '$nfile' failed: $!\n";
+       open my $fh, '>', $nfile;
+       binmode $fh;
        print $fh $_, "\n" for @{$contents{$file}};
-       close $fh or die "failed to close $nfile; aborting: $!\n";
+       close $fh;
 
-       my @stat = stat $file or die "Can't stat $file: $!\n";
+       my @stat = stat $file;
        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";
+       chmod $mode & 0777, $nfile;
     }
 
     # and rename them
@@ -336,7 +393,7 @@ sub do_update {
     for my $file (sort keys %contents) {
        my $nfile = "$file-new";
        warn "updating $file ...\n";
-       rename $nfile, $file or die "rename $nfile $file: $!\n";
+       rename $nfile, $file;
     }
 }