#!/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; 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); }