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