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