Make Porting/bump-perl-version do multiple substitutions per line

[perl5.git] / Porting / bump-perl-version

diff --git a/Porting/bump-perl-version b/Porting/bump-perl-version
index 679aa28..0939b5a 100644 (file)
--- a/Porting/bump-perl-version
+++ b/Porting/bump-perl-version
@@ -45,6 +45,7 @@
 
 use strict;
 use warnings;
+use autodie;
 use Getopt::Std;
 use ExtUtils::Manifest;
 
@@ -56,6 +57,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 +66,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 +86,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]");
@@ -182,6 +186,22 @@ my @maps =  (
        qr/makedef|win32|hints/,      # makedef.pl, 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 { warn "got $& - perl-${1}_${2}_${3}.dir -> perl-${newx}_${newy}_${newz}.dir";  " perl-${1}_${2}_${3}.dir", " perl-${newx}_${newy}_${newz}.dir" },
+       " perl-${oldx}_${oldy}_{$oldz}.dir",
+       qr/README.vms/,
+    ],
+
 );
 
 
@@ -202,6 +222,7 @@ my @SKIP_DIRS = qw(
     ext
     lib
     pod
+    cpan
     t
 );
 
@@ -209,14 +230,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;
 
@@ -230,32 +251,47 @@ sub do_scan {
            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;
            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) {
+           }
+           $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", $., $_, $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;
 }
@@ -279,7 +315,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;
@@ -299,11 +335,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) {
@@ -330,15 +366,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
@@ -346,7 +382,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;
     }
 }