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\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     my $dec = pop @parts;
 151     $dec =~ s/_//g;
 152     $dec .= "0" x ((- length $dec) % 3);
 153     push @parts, $dec =~ /(\d{1,3})/g;
 154   }
 155   $_ += 0 for @parts;
 156   return @parts;
 157 }
 158
 159 sub bump_version {
 160   my ($version, $new) = @_;
 161
 162   my %bump_part = (major => 0, minor => 1, bugfix => 2, last => -1);
 163   my $bump_this = $bump_part{$new||'last'};
 164
 165   my $new_vstring;
 166   my $new_decimal;
 167
 168   if (defined $bump_this) {
 169     if ($version =~ /^v/ || ($version =~ tr/.//) > 1) {
 170       my @parts = version_parts($version);
 171       $parts[$bump_this]++;
 172       $parts[$_] = 0 for (($bump_this < 0 ? @parts : 0)+$bump_this+1 .. $#parts);
 173       $_ += 0
 174         for @parts;
 175       $new_vstring = join '.', @parts;
 176       my $format = '%i.'. join '', map { '%03i' } @parts[1 .. $#parts];
 177       $new_decimal = sprintf $format, @parts;
 178     }
 179     else {
 180       my $alpha_pos = index($version, '_');
 181       $version =~ s/_//g;
 182       $version =~ s/^(\d+)\.//;
 183       my @parts = $1;
 184       push @parts, $version =~ /(\d{1,3})/g;
 185       my $format = '%i.'.join '', map { '%0'.length($_).'i' } @parts[1 .. $#parts];
 186       $parts[$bump_this]++;
 187       $parts[$_] = 0 for (($bump_this < 0 ? @parts : 0)+$bump_this+1 .. $#parts);
 188       $new_decimal = sprintf $format, @parts;
 189       substr $new_decimal, $alpha_pos, 0, '_'
 190         if $alpha_pos != -1;
 191       $new_vstring = join '.', version_parts($new_decimal);
 192     }
 193   }
 194   elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) {
 195     $new_decimal = $new;
 196     $new_vstring = join('.', version_parts($new_decimal));
 197   }
 198   else {
 199     die "no idea which part to bump - $new means nothing to me"
 200   }
 201   return ($new_decimal, $new_vstring);
 202 }
 203