+++ /dev/null
-#!/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|beta|dev' => \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;
- my $in_pod = '';
- for my $ln (0 .. $#lines) {
- my $line = $lines[$ln];
- my $new_line;
- if ($in_pod && $line =~ /^=cut$/) {
- $in_pod = '';
- }
- elsif ($line =~ /^=\w+/) {
- $in_pod = $line;
- }
- elsif (!$in_pod && $line =~ $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 : '');
- $new_line = "$1'$new_decimal'$4$comment$6";
- }
- elsif ($in_pod =~ /\bversion\b/i && $lines[$ln] =~ /^((?:version\s+)?)v?([0-9]+(?:[._][0-9]+)*)$/) {
- die "unable to bump version number in $file from $old_version, found $2\n"
- if !$force && $2 ne $old_version;
- $new_line = "$1$new_decimal";
- }
- if (defined $new_line) {
- $file_diff .= <<"END_DIFF";
-@@ -@{[ $ln ]},3 +@{[ $ln ]},3 @@
- $lines[$ln-1]
--$line
-+$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);
-}