helpers/bump-version

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use File::Find;
   6 use Getopt::Long qw(:config gnu_getopt);
   7 use File::Temp ();
   8
   9 GetOptions(
  10   "git"     => \my $git,
  11   "force"   => \my $force,
  12   'n|dry-run' => \my $dry_run,
  13   'stable'  => \my $stable,
  14   'alpha'   => \my $alpha,
  15 ) or die("Error in command line arguments\n");
  16
  17 my $old_version = shift
  18   or die "no old version provided!\n";
  19 my $bump = shift;
  20 my ($new_decimal, $new_vstring) = bump_version($old_version, $bump);
  21 die "--stable and --alpha are incompatible!\n"
  22   if $stable and $alpha;
  23
  24 warn "Bumping $old_version -> $new_decimal" . ($new_decimal ne $new_vstring ? " ($new_vstring)" : '') . "\n";
  25
  26 my $file_match = qr{
  27   Makefile\.PL
  28   |lib[/\\].*\.(?:pod|pm)
  29   |bin[/\\].*
  30   |script[/\\].*
  31 }x;
  32
  33 my $dir_match = qr{
  34   (?:
  35     .
  36     |lib
  37     |bin
  38     |script
  39   )
  40   (?:[/\\]|$)
  41 }x;
  42
  43 my %files;
  44 if ($git) {
  45   if (system "git diff --quiet --cached HEAD") {
  46     die "Staged changes!\n";
  47   }
  48   for (`git ls-files`) {
  49     chomp;
  50     next
  51       unless /^$file_match$/;
  52     $files{$_} = `git show HEAD:"$_"`;
  53   }
  54 }
  55 else {
  56   find({
  57     no_chdir => 1,
  58     wanted => sub {
  59       my $fn = File::Spec->abs2rel($_, '.');
  60       if (-d && $fn !~ /^$dir_match/) {
  61         $File::Find::prune = 1;
  62         return;
  63       }
  64       return
  65         unless -f;
  66       return
  67         unless $fn =~ /^$file_match$/;
  68       open my $fh, '<', $fn
  69         or die "can't open $fn: $!";
  70       $files{$fn} = do { local $/; <$fh> };
  71       close $fh;
  72     },
  73   }, '.');
  74 }
  75
  76 my $FILE_RE = qr{
  77   (^.* \$VERSION \s* = \s* )
  78   (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
  79   ( \s*; )
  80   (?:
  81     (\s*\#\s*)
  82     v?[.0-9]+
  83   )?
  84   (.*)$
  85 }x;
  86 my $MAKE_RE = qr{
  87   (^.* ['"]?version['"] \s* => \s* )
  88   (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
  89   ( \s*, )
  90   (?:
  91     (\s*\#\s*)
  92     v?[.0-9]+
  93   )?
  94   (.*)$
  95 }x;
  96
  97 my $patch = '';
  98 for my $file (sort keys %files) {
  99   eval {
 100     my $content = $files{$file};
 101     my $file_diff = '';
 102     my $re = $file eq 'Makefile.PL' ? $MAKE_RE : $FILE_RE;
 103     my @lines = split /\r?\n/, $content;
 104     my $in_pod = '';
 105     for my $ln (0 .. $#lines) {
 106       my $line = $lines[$ln];
 107       my $new_line;
 108       if ($in_pod && $line =~ /^=cut$/) {
 109         $in_pod = '';
 110       }
 111       elsif ($line =~ /^=\w+/) {
 112         $in_pod = $line;
 113       }
 114       elsif (!$in_pod && $line =~ $re) {
 115         die "unable to bump version number in $file from $old_version, found $3\n"
 116           if !$force && $3 ne $old_version;
 117         my $comment = ($5 ? $5 . $new_vstring : '');
 118         $new_line = "$1'$new_decimal'$4$comment$6";
 119       }
 120       elsif ($in_pod =~ /\bversion\b/i && $lines[$ln] =~ /^((?:version\s+)?)v?([0-9]+(?:[._][0-9]+)*)$/) {
 121         die "unable to bump version number in $file from $old_version, found $2\n"
 122           if !$force && $2 ne $old_version;
 123         $new_line = "$1$new_decimal";
 124       }
 125       if (defined $new_line) {
 126         $file_diff .= <<"END_DIFF";
 127 @@ -@{[ $ln ]},3 +@{[ $ln ]},3 @@
 128  $lines[$ln-1]
 129 -$line
 130 +$new_line
 131  $lines[$ln+1]
 132 END_DIFF
 133       }
 134     }
 135     if ($file_diff) {
 136       $patch .= <<"END_HEADER" . $file_diff;
 137 --- a/$file
 138 +++ b/$file
 139 END_HEADER
 140     }
 141     1;
 142   } or $dry_run ? warn($@) : die($@);
 143 }
 144
 145 if ($dry_run) {
 146   print $patch;
 147   exit;
 148 }
 149 my ($fh, $file) = File::Temp::tempfile( "bump-version-XXXXXX", TMPDIR => 1 );
 150 print { $fh } $patch;
 151 close $fh;
 152 system qw(git --no-pager apply --apply --stat), $file
 153   and exit 1;
 154
 155 if ($git) {
 156   system qw(git apply --cached), $file
 157     and exit 1;
 158
 159   my $message = "Bumping version to $new_decimal";
 160   system qw(git commit -m), $message
 161     and exit 1;
 162 }
 163
 164 sub version_parts {
 165   my $version = shift;
 166   my $dotted = $version =~ s/^v//;
 167   my @parts = split /\./, $version;
 168   if (!$dotted && @parts <= 2) {
 169     tr/_//d for @parts;
 170     if (@parts == 2) {
 171       my $dec = pop @parts;
 172       $dec .= "0" x ((- length $dec) % 3);
 173       push @parts, $dec =~ /(\d{1,3})/g;
 174     }
 175   }
 176   elsif ($version =~ tr/_//) {
 177     die "don't know how to handle underscores in dotted-decimal versions!\n";
 178   }
 179   $_ += 0 for @parts;
 180   return @parts;
 181 }
 182
 183 sub bump_version {
 184   my ($version, $new) = @_;
 185
 186   my %bump_part = (major => 0, minor => 1, bugfix => 2, last => -1);
 187   my $bump_this = $bump_part{$new||'last'};
 188
 189   my $new_vstring;
 190   my $new_decimal;
 191
 192   if (defined $bump_this) {
 193     if ($version =~ /^v/ || ($version =~ tr/.//) > 1) {
 194       my $v = $version =~ /^(v)/ ? $1 : '';
 195       if ($version =~ tr/_//d && !$stable || $alpha) {
 196         die "can't bump dotted decimal versions with alpha components!\n";
 197       }
 198       my @parts = version_parts($version);
 199       $bump_this += @parts
 200         if $bump_this < 0;
 201       $parts[$_] = 0 for $bump_this+1 .. $#parts;
 202       $parts[$_] = 0 for $#parts+1 .. $bump_this;
 203       $parts[$bump_this]++;
 204       $_ += 0
 205         for @parts;
 206       if (grep $_ > 999, @parts[1 .. $#parts]) {
 207         warn "$new_decimal has a version component greater than 999.  It will be incompatible with some uses in perl.\n";
 208       }
 209       $new_decimal = $new_vstring = $v . join '.', @parts;
 210     }
 211     else {
 212       my $alpha_pos;
 213       if (!$stable) {
 214         $alpha_pos = index($version, '_');
 215         if ($alpha_pos == -1) {
 216           undef $alpha_pos;
 217         }
 218         else {
 219           my $dot_pos = index($version, '.');
 220           $alpha_pos = $dot_pos == -1 ? -$alpha_pos : $alpha_pos - $dot_pos;
 221         }
 222       }
 223       $new_decimal = $version;
 224       $new_decimal =~ tr/_//d;
 225       my $dec_len = $new_decimal =~ /(\.\d+)/ ? length($1) - 1 : 0;
 226       if ($bump_this != -1) {
 227         my $cut_len = $bump_this * 3;
 228         $dec_len = $cut_len
 229           if $dec_len < $cut_len;
 230         $new_decimal =~ s/(\..{1,$cut_len}).*/$1/;
 231       }
 232       $new_decimal += 10 ** -($bump_this == -1 ? $dec_len : ($bump_this * 3));
 233       $new_decimal = sprintf "%.${dec_len}f", $new_decimal;
 234       if ($alpha) {
 235         $alpha_pos ||= $dec_len >= 2 ? int($dec_len / 2) + 1 :
 236           die "don't know how to make $new_decimal into an alpha version";
 237       }
 238       if (defined $alpha_pos) {
 239         my $dot_pos = index($new_decimal, '.');
 240         $dot_pos = length $new_decimal
 241           if $dot_pos == -1;
 242         substr $new_decimal, $dot_pos + $alpha_pos, 0, '_';
 243       }
 244       $new_vstring = 'v' . join '.', version_parts($new_decimal);
 245     }
 246   }
 247   elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) {
 248     $new_decimal = $new;
 249     $new_vstring = join('.', version_parts($new_decimal));
 250   }
 251   else {
 252     die "no idea which part to bump - $new means nothing to me"
 253   }
 254   return ($new_decimal, $new_vstring);
 255 }