4 use warnings FATAL => 'all';
6 use Getopt::Long qw(:config gnu_getopt);
11 "force" => \my $force,
12 'n|dry-run' => \my $dry_run,
13 'stable' => \my $stable,
14 'alpha' => \my $alpha,
15 ) or die("Error in command line arguments\n");
17 my $old_version = shift
18 or die "no old version provided!\n";
20 my ($new_decimal, $new_vstring) = bump_version($old_version, $bump);
21 die "--stable and --alpha are incompatible!\n"
22 if $stable and $alpha;
24 warn "Bumping $old_version -> $new_decimal" . ($new_decimal ne $new_vstring ? " ($new_vstring)" : '') . "\n";
28 |lib[/\\].*\.(?:pod|pm)
45 if (system "git diff --quiet --cached HEAD") {
46 die "Staged changes!\n";
48 for (`git ls-files`) {
51 unless /^$file_match$/;
52 $files{$_} = `git show HEAD:"$_"`;
59 my $fn = File::Spec->abs2rel($_, '.');
60 if (-d && $fn !~ /^$dir_match/) {
61 $File::Find::prune = 1;
67 unless $fn =~ /^$file_match$/;
69 or die "can't open $fn: $!";
70 $files{$fn} = do { local $/; <$fh> };
77 (^.* \$VERSION \s* = \s* )
78 (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
87 (^.* ['"]?version['"] \s* => \s* )
88 (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2
98 for my $file (sort keys %files) {
100 my $content = $files{$file};
102 my $re = $file eq 'Makefile.PL' ? $MAKE_RE : $FILE_RE;
103 my @lines = split /\r?\n/, $content;
104 for my $ln (0 .. $#lines) {
105 my $line = $lines[$ln];
106 if ($lines[$ln] =~ $re) {
107 die "unable to bump version number in $file from $old_version, found $3\n"
108 if !$force && $3 ne $old_version;
109 my $comment = ($5 ? $5 . $new_vstring : '');
110 my $new_line = "$1'$new_decimal'$4$comment$6";
111 $file_diff .= <<"END_DIFF";
112 @@ -@{[ $ln ]},3 +@{[ $ln ]},3 @@
121 $patch .= <<"END_HEADER" . $file_diff;
127 } or $dry_run ? warn($@) : die($@);
134 my ($fh, $file) = File::Temp::tempfile( "bump-version-XXXXXX", TMPDIR => 1 );
135 print { $fh } $patch;
137 system qw(git --no-pager apply --apply --stat), $file
141 system qw(git apply --cached), $file
144 my $message = "Bumping version to $new_decimal";
145 system qw(git commit -m), $message
151 my $dotted = $version =~ s/^v//;
152 my @parts = split /\./, $version;
153 if (!$dotted && @parts <= 2) {
156 my $dec = pop @parts;
157 $dec .= "0" x ((- length $dec) % 3);
158 push @parts, $dec =~ /(\d{1,3})/g;
161 elsif ($version =~ tr/_//) {
162 die "don't know how to handle underscores in dotted-decimal versions!\n";
169 my ($version, $new) = @_;
171 my %bump_part = (major => 0, minor => 1, bugfix => 2, last => -1);
172 my $bump_this = $bump_part{$new||'last'};
177 if (defined $bump_this) {
178 if ($version =~ /^v/ || ($version =~ tr/.//) > 1) {
179 my $v = $version =~ /^(v)/ ? $1 : '';
180 if ($version =~ tr/_//d && !$stable || $alpha) {
181 die "can't bump dotted decimal versions with alpha components!\n";
183 my @parts = version_parts($version);
186 $parts[$_] = 0 for $bump_this+1 .. $#parts;
187 $parts[$_] = 0 for $#parts+1 .. $bump_this;
188 $parts[$bump_this]++;
191 if (grep $_ > 999, @parts[1 .. $#parts]) {
192 warn "$new_decimal has a version component greater than 999. It will be incompatible with some uses in perl.\n";
194 $new_decimal = $new_vstring = $v . join '.', @parts;
199 $alpha_pos = index($version, '_');
200 if ($alpha_pos == -1) {
204 my $dot_pos = index($version, '.');
205 $alpha_pos = $dot_pos == -1 ? -$alpha_pos : $alpha_pos - $dot_pos;
208 $new_decimal = $version;
209 $new_decimal =~ tr/_//d;
210 my $dec_len = $new_decimal =~ /(\.\d+)/ ? length($1) - 1 : 0;
211 if ($bump_this != -1) {
212 my $cut_len = $bump_this * 3;
214 if $dec_len < $cut_len;
215 $new_decimal =~ s/(\..{1,$cut_len}).*/$1/;
217 $new_decimal += 10 ** -($bump_this == -1 ? $dec_len : ($bump_this * 3));
218 $new_decimal = sprintf "%.${dec_len}f", $new_decimal;
220 $alpha_pos ||= $dec_len >= 2 ? int($dec_len / 2) + 1 :
221 die "don't know how to make $new_decimal into an alpha version";
223 if (defined $alpha_pos) {
224 my $dot_pos = index($new_decimal, '.');
225 $dot_pos = length $new_decimal
227 substr $new_decimal, $dot_pos + $alpha_pos, 0, '_';
229 $new_vstring = 'v' . join '.', version_parts($new_decimal);
232 elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) {
234 $new_vstring = join('.', version_parts($new_decimal));
237 die "no idea which part to bump - $new means nothing to me"
239 return ($new_decimal, $new_vstring);