Commit | Line | Data |
8ab5ea70 |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | use File::Find; |
25f4abaf |
6 | use Getopt::Long qw(:config gnu_getopt); |
ece2756d |
7 | use File::Temp (); |
8 | |
9 | GetOptions( |
126a88c1 |
10 | 'git' => \my $git, |
11 | 'force' => \my $force, |
12 | 'n|dry-run' => \my $dry_run, |
13 | 'stable' => \my $stable, |
14 | 'alpha|beta|dev' => \my $alpha, |
ece2756d |
15 | ) or die("Error in command line arguments\n"); |
16 | |
eb3aeb36 |
17 | my $old_version = shift |
18 | or die "no old version provided!\n"; |
19 | my $bump = shift; |
ece2756d |
20 | my ($new_decimal, $new_vstring) = bump_version($old_version, $bump); |
edb3d044 |
21 | die "--stable and --alpha are incompatible!\n" |
22 | if $stable and $alpha; |
ece2756d |
23 | |
6c6e7dc3 |
24 | warn "Bumping $old_version -> $new_decimal" . ($new_decimal ne $new_vstring ? " ($new_vstring)" : '') . "\n"; |
ece2756d |
25 | |
f39746fb |
26 | my $file_match = qr{ |
343f5d00 |
27 | Makefile\.PL |
28 | |lib[/\\].*\.(?:pod|pm) |
29 | |bin[/\\].* |
30 | |script[/\\].* |
f39746fb |
31 | }x; |
32 | |
33 | my $dir_match = qr{ |
34 | (?: |
35 | . |
36 | |lib |
37 | |bin |
38 | |script |
39 | ) |
40 | (?:[/\\]|$) |
41 | }x; |
343f5d00 |
42 | |
ece2756d |
43 | my %files; |
44 | if ($git) { |
176acdb4 |
45 | if (system "git diff --quiet --cached HEAD") { |
ece2756d |
46 | die "Staged changes!\n"; |
47 | } |
48 | for (`git ls-files`) { |
49 | chomp; |
50 | next |
f39746fb |
51 | unless /^$file_match$/; |
ece2756d |
52 | $files{$_} = `git show HEAD:"$_"`; |
53 | } |
54 | } |
55 | else { |
56 | find({ |
57 | no_chdir => 1, |
58 | wanted => sub { |
f39746fb |
59 | my $fn = File::Spec->abs2rel($_, '.'); |
25bd077d |
60 | if (-d && $fn !~ /^$dir_match/) { |
f39746fb |
61 | $File::Find::prune = 1; |
62 | return; |
63 | } |
64 | return |
ece2756d |
65 | unless -f; |
f39746fb |
66 | return |
67 | unless $fn =~ /^$file_match$/; |
68 | open my $fh, '<', $fn |
69 | or die "can't open $fn: $!"; |
70 | $files{$fn} = do { local $/; <$fh> }; |
ece2756d |
71 | close $fh; |
72 | }, |
343f5d00 |
73 | }, '.'); |
ece2756d |
74 | } |
75 | |
76 | my $FILE_RE = qr{ |
77 | (^.* \$VERSION \s* = \s* ) |
78 | (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2 |
79 | ( \s*; ) |
80 | (?: |
81 | (\s*\#\s*) |
82 | v?[.0-9]+ |
83 | )? |
84 | (.*)$ |
85 | }x; |
86 | my $MAKE_RE = qr{ |
122ab998 |
87 | (^.* ['"]?(?:version|VERSION)['"]? \s* => \s* ) |
ece2756d |
88 | (['"]?) v?([0-9]+(?:[._][0-9]+)*) \2 |
89 | ( \s*, ) |
90 | (?: |
91 | (\s*\#\s*) |
92 | v?[.0-9]+ |
93 | )? |
94 | (.*)$ |
95 | }x; |
96 | |
97 | my $patch = ''; |
98 | for my $file (sort keys %files) { |
6d17b785 |
99 | eval { |
100 | my $content = $files{$file}; |
101 | my $file_diff = ''; |
102 | my $re = $file eq 'Makefile.PL' ? $MAKE_RE : $FILE_RE; |
103 | my @lines = split /\r?\n/, $content; |
91019678 |
104 | my $in_pod = ''; |
6d17b785 |
105 | for my $ln (0 .. $#lines) { |
106 | my $line = $lines[$ln]; |
91019678 |
107 | my $new_line; |
108 | if ($in_pod && $line =~ /^=cut$/) { |
109 | $in_pod = ''; |
110 | } |
111 | elsif ($line =~ /^=\w+/) { |
112 | $in_pod = $line; |
113 | } |
114 | elsif (!$in_pod && $line =~ $re) { |
6d17b785 |
115 | die "unable to bump version number in $file from $old_version, found $3\n" |
116 | if !$force && $3 ne $old_version; |
117 | my $comment = ($5 ? $5 . $new_vstring : ''); |
91019678 |
118 | $new_line = "$1'$new_decimal'$4$comment$6"; |
119 | } |
120 | elsif ($in_pod =~ /\bversion\b/i && $lines[$ln] =~ /^((?:version\s+)?)v?([0-9]+(?:[._][0-9]+)*)$/) { |
121 | die "unable to bump version number in $file from $old_version, found $2\n" |
122 | if !$force && $2 ne $old_version; |
123 | $new_line = "$1$new_decimal"; |
124 | } |
125 | if (defined $new_line) { |
6d17b785 |
126 | $file_diff .= <<"END_DIFF"; |
ece2756d |
127 | @@ -@{[ $ln ]},3 +@{[ $ln ]},3 @@ |
128 | $lines[$ln-1] |
91019678 |
129 | -$line |
ece2756d |
130 | +$new_line |
131 | $lines[$ln+1] |
132 | END_DIFF |
6d17b785 |
133 | } |
ece2756d |
134 | } |
6d17b785 |
135 | if ($file_diff) { |
136 | $patch .= <<"END_HEADER" . $file_diff; |
ece2756d |
137 | --- a/$file |
138 | +++ b/$file |
139 | END_HEADER |
6d17b785 |
140 | } |
141 | 1; |
142 | } or $dry_run ? warn($@) : die($@); |
ece2756d |
143 | } |
144 | |
6d17b785 |
145 | if ($dry_run) { |
146 | print $patch; |
147 | exit; |
148 | } |
ece2756d |
149 | my ($fh, $file) = File::Temp::tempfile( "bump-version-XXXXXX", TMPDIR => 1 ); |
150 | print { $fh } $patch; |
151 | close $fh; |
413a726c |
152 | system qw(git --no-pager apply --apply --stat), $file |
ece2756d |
153 | and exit 1; |
154 | |
155 | if ($git) { |
156 | system qw(git apply --cached), $file |
157 | and exit 1; |
158 | |
159 | my $message = "Bumping version to $new_decimal"; |
160 | system qw(git commit -m), $message |
161 | and exit 1; |
162 | } |
8ab5ea70 |
163 | |
164 | sub version_parts { |
576656c4 |
165 | my $version = shift; |
166 | my $dotted = $version =~ s/^v//; |
167 | my @parts = split /\./, $version; |
f7d6fb43 |
168 | if (!$dotted && @parts <= 2) { |
169 | tr/_//d for @parts; |
170 | if (@parts == 2) { |
171 | my $dec = pop @parts; |
172 | $dec .= "0" x ((- length $dec) % 3); |
173 | push @parts, $dec =~ /(\d{1,3})/g; |
174 | } |
175 | } |
176 | elsif ($version =~ tr/_//) { |
177 | die "don't know how to handle underscores in dotted-decimal versions!\n"; |
8ab5ea70 |
178 | } |
179 | $_ += 0 for @parts; |
8ab5ea70 |
180 | return @parts; |
181 | } |
182 | |
ece2756d |
183 | sub bump_version { |
150fcad0 |
184 | my ($version, $new) = @_; |
8ab5ea70 |
185 | |
de42f557 |
186 | my %bump_part = (major => 0, minor => 1, bugfix => 2, patch => 2, last => -1); |
150fcad0 |
187 | my $bump_this = $bump_part{$new||'last'}; |
576656c4 |
188 | |
ece2756d |
189 | my $new_vstring; |
190 | my $new_decimal; |
8ab5ea70 |
191 | |
ece2756d |
192 | if (defined $bump_this) { |
150fcad0 |
193 | if ($version =~ /^v/ || ($version =~ tr/.//) > 1) { |
6c6e7dc3 |
194 | my $v = $version =~ /^(v)/ ? $1 : ''; |
edb3d044 |
195 | if ($version =~ tr/_//d && !$stable || $alpha) { |
196 | die "can't bump dotted decimal versions with alpha components!\n"; |
197 | } |
150fcad0 |
198 | my @parts = version_parts($version); |
6c6e7dc3 |
199 | $bump_this += @parts |
200 | if $bump_this < 0; |
201 | $parts[$_] = 0 for $bump_this+1 .. $#parts; |
202 | $parts[$_] = 0 for $#parts+1 .. $bump_this; |
150fcad0 |
203 | $parts[$bump_this]++; |
150fcad0 |
204 | $_ += 0 |
205 | for @parts; |
e05a4bcc |
206 | if (grep $_ > 999, @parts[1 .. $#parts]) { |
207 | warn "$new_decimal has a version component greater than 999. It will be incompatible with some uses in perl.\n"; |
208 | } |
6c6e7dc3 |
209 | $new_decimal = $new_vstring = $v . join '.', @parts; |
150fcad0 |
210 | } |
211 | else { |
edb3d044 |
212 | my $alpha_pos; |
213 | if (!$stable) { |
214 | $alpha_pos = index($version, '_'); |
215 | if ($alpha_pos == -1) { |
216 | undef $alpha_pos; |
217 | } |
218 | else { |
219 | my $dot_pos = index($version, '.'); |
220 | $alpha_pos = $dot_pos == -1 ? -$alpha_pos : $alpha_pos - $dot_pos; |
221 | } |
f7d6fb43 |
222 | } |
223 | $new_decimal = $version; |
224 | $new_decimal =~ tr/_//d; |
225 | my $dec_len = $new_decimal =~ /(\.\d+)/ ? length($1) - 1 : 0; |
226 | if ($bump_this != -1) { |
227 | my $cut_len = $bump_this * 3; |
228 | $dec_len = $cut_len |
229 | if $dec_len < $cut_len; |
70bb577e |
230 | if ($cut_len) { |
231 | $new_decimal =~ s/(\..{1,$cut_len}).*/$1/; |
232 | } |
233 | else { |
234 | $new_decimal =~ s/\..*//; |
235 | } |
f7d6fb43 |
236 | } |
237 | $new_decimal += 10 ** -($bump_this == -1 ? $dec_len : ($bump_this * 3)); |
238 | $new_decimal = sprintf "%.${dec_len}f", $new_decimal; |
edb3d044 |
239 | if ($alpha) { |
240 | $alpha_pos ||= $dec_len >= 2 ? int($dec_len / 2) + 1 : |
241 | die "don't know how to make $new_decimal into an alpha version"; |
242 | } |
f7d6fb43 |
243 | if (defined $alpha_pos) { |
244 | my $dot_pos = index($new_decimal, '.'); |
245 | $dot_pos = length $new_decimal |
246 | if $dot_pos == -1; |
247 | substr $new_decimal, $dot_pos + $alpha_pos, 0, '_'; |
248 | } |
249 | $new_vstring = 'v' . join '.', version_parts($new_decimal); |
150fcad0 |
250 | } |
ece2756d |
251 | } |
252 | elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) { |
253 | $new_decimal = $new; |
254 | $new_vstring = join('.', version_parts($new_decimal)); |
255 | } |
256 | else { |
257 | die "no idea which part to bump - $new means nothing to me" |
258 | } |
259 | return ($new_decimal, $new_vstring); |
a4c19845 |
260 | } |