fix directory calculations without --git

[p5sagit/Distar.git] / helpers / bump-version

#!/usr/bin/env perl

use strict;
use warnings FATAL => 'all';
use File::Find;
use Getopt::Long qw(:config gnu_getopt);
use File::Temp ();

GetOptions(
  "git"     => \my $git,
  "force"   => \my $force,
  'n|dry-run' => \my $dry_run,
  'stable'  => \my $stable,
  'alpha'   => \my $alpha,
) or die("Error in command line arguments\n");

my $old_version = shift
  or die "no old version provided!\n";
my $bump = shift;
my ($new_decimal, $new_vstring) = bump_version($old_version, $bump);
die "--stable and --alpha are incompatible!\n"
  if $stable and $alpha;

warn "Bumping $old_version -> $new_decimal" . ($new_decimal ne $new_vstring ? " ($new_vstring)" : '') . "\n";

my $file_match = qr{
  Makefile\.PL
  |lib[/\\].*\.(?:pod|pm)
  |bin[/\\].*
  |script[/\\].*
}x;

my $dir_match = qr{
  (?:
    .
    |lib
    |bin
    |script
  )
  (?:[/\\]|$)
}x;

my %files;
if ($git) {
  if (system "git diff --quiet --cached HEAD") {
    die "Staged changes!\n";
  }
  for (`git ls-files`) {
    chomp;
    next
      unless /^$file_match$/;
    $files{$_} = `git show HEAD:"$_"`;
  }
}
else {
  find({
    no_chdir => 1,
    wanted => sub {
      my $fn = File::Spec->abs2rel($_, '.');
      if (-d && $fn !~ /^$dir_match/) {
        $File::Find::prune = 1;
        return;
      }
      return
        unless -f;
      return
        unless $fn =~ /^$file_match$/;
      open my $fh, '<', $fn
        or die "can't open $fn: $!";
      $files{$fn} = do { local $/; <$fh> };
      close $fh;
    },
  }, '.');
}

my $FILE_RE = qr{
  (^.* \$VERSION \s* = \s* )
  (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
  ( \s*; )
  (?:
    (\s*\#\s*)
    v?[.0-9]+
  )?
  (.*)$
}x;
my $MAKE_RE = qr{
  (^.* ['"]?version['"] \s* => \s* )
  (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
  ( \s*, )
  (?:
    (\s*\#\s*)
    v?[.0-9]+
  )?
  (.*)$
}x;

my $patch = '';
for my $file (sort keys %files) {
  eval {
    my $content = $files{$file};
    my $file_diff = '';
    my $re = $file eq 'Makefile.PL' ? $MAKE_RE : $FILE_RE;
    my @lines = split /\r?\n/, $content;
    for my $ln (0 .. $#lines) {
      my $line = $lines[$ln];
      if ($lines[$ln] =~ $re) {
        die "unable to bump version number in $file from $old_version, found $3\n"
          if !$force && $3 ne $old_version;
        my $comment = ($5 ? $5 . $new_vstring : '');
        my $new_line = "$1'$new_decimal'$4$comment$6";
        $file_diff .= <<"END_DIFF";
@@ -@{[ $ln ]},3 +@{[ $ln ]},3 @@
 $lines[$ln-1]
-$lines[$ln]
+$new_line
 $lines[$ln+1]
END_DIFF
      }
    }
    if ($file_diff) {
      $patch .= <<"END_HEADER" . $file_diff;
--- a/$file
+++ b/$file
END_HEADER
    }
    1;
  } or $dry_run ? warn($@) : die($@);
}

if ($dry_run) {
  print $patch;
  exit;
}
my ($fh, $file) = File::Temp::tempfile( "bump-version-XXXXXX", TMPDIR => 1 );
print { $fh } $patch;
close $fh;
system qw(git --no-pager apply --apply --stat), $file
  and exit 1;

if ($git) {
  system qw(git apply --cached), $file
    and exit 1;

  my $message = "Bumping version to $new_decimal";
  system qw(git commit -m), $message
    and exit 1;
}

sub version_parts {
  my $version = shift;
  my $dotted = $version =~ s/^v//;
  my @parts = split /\./, $version;
  if (!$dotted && @parts <= 2) {
    tr/_//d for @parts;
    if (@parts == 2) {
      my $dec = pop @parts;
      $dec .= "0" x ((- length $dec) % 3);
      push @parts, $dec =~ /(\d{1,3})/g;
    }
  }
  elsif ($version =~ tr/_//) {
    die "don't know how to handle underscores in dotted-decimal versions!\n";
  }
  $_ += 0 for @parts;
  return @parts;
}

sub bump_version {
  my ($version, $new) = @_;

  my %bump_part = (major => 0, minor => 1, bugfix => 2, last => -1);
  my $bump_this = $bump_part{$new||'last'};

  my $new_vstring;
  my $new_decimal;

  if (defined $bump_this) {
    if ($version =~ /^v/ || ($version =~ tr/.//) > 1) {
      my $v = $version =~ /^(v)/ ? $1 : '';
      if ($version =~ tr/_//d && !$stable || $alpha) {
        die "can't bump dotted decimal versions with alpha components!\n";
      }
      my @parts = version_parts($version);
      $bump_this += @parts
        if $bump_this < 0;
      $parts[$_] = 0 for $bump_this+1 .. $#parts;
      $parts[$_] = 0 for $#parts+1 .. $bump_this;
      $parts[$bump_this]++;
      $_ += 0
        for @parts;
      if (grep $_ > 999, @parts[1 .. $#parts]) {
        warn "$new_decimal has a version component greater than 999.  It will be incompatible with some uses in perl.\n";
      }
      $new_decimal = $new_vstring = $v . join '.', @parts;
    }
    else {
      my $alpha_pos;
      if (!$stable) {
        $alpha_pos = index($version, '_');
        if ($alpha_pos == -1) {
          undef $alpha_pos;
        }
        else {
          my $dot_pos = index($version, '.');
          $alpha_pos = $dot_pos == -1 ? -$alpha_pos : $alpha_pos - $dot_pos;
        }
      }
      $new_decimal = $version;
      $new_decimal =~ tr/_//d;
      my $dec_len = $new_decimal =~ /(\.\d+)/ ? length($1) - 1 : 0;
      if ($bump_this != -1) {
        my $cut_len = $bump_this * 3;
        $dec_len = $cut_len
          if $dec_len < $cut_len;
        $new_decimal =~ s/(\..{1,$cut_len}).*/$1/;
      }
      $new_decimal += 10 ** -($bump_this == -1 ? $dec_len : ($bump_this * 3));
      $new_decimal = sprintf "%.${dec_len}f", $new_decimal;
      if ($alpha) {
        $alpha_pos ||= $dec_len >= 2 ? int($dec_len / 2) + 1 :
          die "don't know how to make $new_decimal into an alpha version";
      }
      if (defined $alpha_pos) {
        my $dot_pos = index($new_decimal, '.');
        $dot_pos = length $new_decimal
          if $dot_pos == -1;
        substr $new_decimal, $dot_pos + $alpha_pos, 0, '_';
      }
      $new_vstring = 'v' . join '.', version_parts($new_decimal);
    }
  }
  elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) {
    $new_decimal = $new;
    $new_vstring = join('.', version_parts($new_decimal));
  }
  else {
    die "no idea which part to bump - $new means nothing to me"
  }
  return ($new_decimal, $new_vstring);
}