Commit | Line | Data |
---|---|---|
33e80a47 | 1 | #!/usr/bin/env perl |
418f4069 | 2 | |
c5e3e317 JL |
3 | =head1 NAME |
4 | ||
f703fc96 | 5 | Porting/sync-with-cpan - Synchronize with CPAN distributions |
c5e3e317 JL |
6 | |
7 | =head1 SYNOPSIS | |
8 | ||
0b2c8fe5 JK |
9 | sh ./Configure |
10 | perl Porting/sync-with-cpan <module> | |
c5e3e317 | 11 | |
5c5e39fe | 12 | where C<module> is the name it appears in the C<%Modules> hash |
c5e3e317 JL |
13 | of F<Porting/Maintainers.pl> |
14 | ||
15 | =head1 DESCRIPTION | |
16 | ||
17 | Script to help out with syncing cpan distros. | |
18 | ||
19 | Does the following: | |
20 | ||
21 | =over 4 | |
22 | ||
23 | =item * | |
24 | ||
25 | Fetches the package list from CPAN. Finds the current version of the given | |
26 | package. [1] | |
27 | ||
28 | =item * | |
29 | ||
30 | Downloads the relevant tarball; unpacks the tarball. [1] | |
31 | ||
32 | =item * | |
33 | ||
34 | Clean out the old directory (C<git clean -dfx>) | |
35 | ||
36 | =item * | |
37 | ||
38 | Moves the old directory out of the way, moves the new directory in place. | |
39 | ||
40 | =item * | |
41 | ||
42 | Restores any F<.gitignore> file. | |
43 | ||
44 | =item * | |
45 | ||
46 | Removes files from C<@IGNORE> and C<EXCLUDED> | |
47 | ||
48 | =item * | |
49 | ||
50 | C<git add> any new files. | |
51 | ||
52 | =item * | |
53 | ||
54 | C<git rm> any files that are gone. | |
55 | ||
56 | =item * | |
57 | ||
58 | Remove the +x bit on files in F<t/> | |
59 | ||
60 | =item * | |
61 | ||
62 | Remove the +x bit on files that don't have it enabled in the current dir | |
63 | ||
64 | =item * | |
65 | ||
66 | Restore files mentioned in C<CUSTOMIZED> | |
67 | ||
68 | =item * | |
69 | ||
190c1b3b | 70 | Updates the contents of F<MANIFEST> |
c5e3e317 JL |
71 | |
72 | =item * | |
73 | ||
74 | Runs a C<make> (assumes a configure has been run) | |
75 | ||
76 | =item * | |
77 | ||
78 | Cleans up | |
79 | ||
80 | =item * | |
81 | ||
82 | Runs tests for the package | |
83 | ||
84 | =item * | |
85 | ||
86 | Runs the porting tests | |
87 | ||
88 | =back | |
89 | ||
90 | [1] If the C<--tarball> option is given, then CPAN is not consulted. | |
91 | C<--tarball> should be the path to the tarball; the version is extracted | |
92 | from the filename -- but can be overwritten by the C<--version> option. | |
93 | ||
b7078f1e AC |
94 | =head1 OPTIONS |
95 | ||
96 | =over 4 | |
97 | ||
98 | =item C<--jobs> I<N> | |
99 | ||
100 | When running C<make>, pass a C<< -jI<N> >> option to it. | |
101 | ||
102 | =back | |
103 | ||
c5e3e317 JL |
104 | =head1 TODO |
105 | ||
106 | =over 4 | |
107 | ||
108 | =item * | |
109 | ||
c5e3e317 JL |
110 | Update F<Porting/Maintainers.pl> |
111 | ||
112 | =item * | |
113 | ||
114 | Optional, run a full test suite | |
115 | ||
116 | =item * | |
117 | ||
118 | Handle complicated C<FILES> | |
119 | ||
120 | =back | |
121 | ||
122 | This is an initial version; no attempt has been made yet to make this | |
123 | portable. It shells out instead of trying to find a Perl solution. | |
cd9a1714 | 124 | In particular, it assumes git, perl, and make |
c5e3e317 JL |
125 | to be available. |
126 | ||
127 | =cut | |
128 | ||
418f4069 | 129 | |
4d18e0a2 A |
130 | package Maintainers; |
131 | ||
418f4069 A |
132 | use 5.010; |
133 | ||
134 | use strict; | |
135 | use warnings; | |
4d18e0a2 | 136 | use Getopt::Long; |
a1450e8b | 137 | use Archive::Tar; |
bd4de633 | 138 | use File::Basename qw( basename ); |
192f56b0 | 139 | use File::Path qw( remove_tree ); |
fc134225 | 140 | use File::Find; |
84709797 | 141 | use File::Spec::Functions qw( tmpdir rel2abs ); |
160daab8 | 142 | use Config qw( %Config ); |
418f4069 A |
143 | |
144 | $| = 1; | |
145 | ||
215d9c65 AC |
146 | use constant WIN32 => $^O eq 'MSWin32'; |
147 | ||
07a826df | 148 | die "This does not look like a top level directory" |
418f4069 A |
149 | unless -d "cpan" && -d "Porting"; |
150 | ||
4b760246 AC |
151 | # Check that there's a Makefile, if needed; otherwise, we'll do most of our |
152 | # work only to fail when we try to run make, and the user will have to | |
153 | # either unpick everything we've done, or do the rest manually. | |
154 | die "Please run Configure before using $0\n" | |
155 | if !WIN32 && !-f "Makefile"; | |
156 | ||
418f4069 A |
157 | our @IGNORABLE; |
158 | our %Modules; | |
159 | ||
160 | use autodie; | |
161 | ||
b27c755c | 162 | require "./Porting/Maintainers.pl"; |
418f4069 | 163 | |
e6e4cae9 AC |
164 | my $MAKE_LOG = 'make.log'; |
165 | ||
418f4069 A |
166 | my %IGNORABLE = map {$_ => 1} @IGNORABLE; |
167 | ||
af8c53c3 | 168 | my $tmpdir = tmpdir(); |
fc134225 | 169 | |
418f4069 A |
170 | my $package = "02packages.details.txt"; |
171 | my $package_url = "http://www.cpan.org/modules/$package"; | |
fc134225 | 172 | my $package_file = "$tmpdir/$package"; # this is a cache |
418f4069 | 173 | |
b7e2b692 JL |
174 | my @problematic = ( |
175 | 'podlators', # weird CUSTOMIZED section due to .PL files | |
176 | ); | |
177 | ||
418f4069 | 178 | |
311454c0 MB |
179 | sub usage |
180 | { | |
181 | my $err = shift and select STDERR; | |
382558a5 | 182 | print "Usage: $0 <module-or-dist> [args]\n"; |
311454c0 MB |
183 | exit $err; |
184 | } | |
185 | ||
4d18e0a2 | 186 | GetOptions ('tarball=s' => \my $tarball, |
b5bf278a | 187 | 'version=s' => \my $version, |
b7078f1e | 188 | 'jobs=i' => \my $make_jobs, |
311454c0 MB |
189 | force => \my $force, |
190 | help => sub { usage 0; }, | |
191 | ) or die "Failed to parse arguments"; | |
4d18e0a2 | 192 | |
311454c0 | 193 | usage 1 unless @ARGV == 1 || @ARGV == 2; |
418f4069 | 194 | |
fc134225 MM |
195 | sub find_type_f { |
196 | my @res; | |
197 | find( { no_chdir => 1, wanted => sub { | |
198 | my $file= $File::Find::name; | |
199 | return unless -f $file; | |
200 | push @res, $file | |
201 | }}, @_ ); | |
202 | @res | |
203 | }; | |
204 | ||
cd9a1714 MM |
205 | # Equivalent of `chmod a-x` |
206 | sub de_exec { | |
746bc9e1 AC |
207 | my ($filename) = @_; |
208 | my $mode = (stat $filename)[2] & 0777; | |
209 | if ($mode & 0111) { # exec-bit set | |
210 | chmod $mode & 0666, $filename; | |
cd9a1714 MM |
211 | } |
212 | } | |
213 | ||
b6574671 AC |
214 | # Equivalent of `chmod +w` |
215 | sub make_writable { | |
216 | my ($filename) = @_; | |
217 | my $mode = (stat $filename)[2] & 0777; | |
218 | if (!($mode & 0222)) { # not writable | |
219 | chmod $mode | (0222 & ~umask), $filename; | |
220 | } | |
221 | } | |
222 | ||
cd9a1714 | 223 | sub make { |
160daab8 | 224 | my @args= @_; |
b7078f1e | 225 | unshift @args, "-j$make_jobs" if defined $make_jobs; |
215d9c65 | 226 | if (WIN32) { |
160daab8 | 227 | chdir "Win32"; |
e6e4cae9 AC |
228 | system "$Config{make} @args> ..\\$MAKE_LOG 2>&1" |
229 | and die "Running make failed, see $MAKE_LOG"; | |
160daab8 MM |
230 | chdir '..'; |
231 | } else { | |
e6e4cae9 AC |
232 | system "$Config{make} @args> $MAKE_LOG 2>&1" |
233 | and die "Running make failed, see $MAKE_LOG"; | |
160daab8 MM |
234 | }; |
235 | }; | |
236 | ||
5b73aae5 | 237 | my ($module) = shift; |
418f4069 | 238 | |
24c7e242 AC |
239 | my $info = $Modules{$module}; |
240 | if (!$info) { | |
469f7948 AC |
241 | # Maybe the user said "Test-Simple" instead of "Test::Simple", or |
242 | # "IO::Compress" instead of "IO-Compress". See if we can fix it up. | |
243 | my $guess = $module; | |
244 | s/-/::/g or s/::/-/g for $guess; | |
245 | $info = $Modules{$guess} or die <<"EOF"; | |
246 | Cannot find module $module. | |
247 | The available options are listed in the %Modules hash in Porting/Maintainers.pl | |
248 | EOF | |
24c7e242 AC |
249 | say "Guessing you meant $guess instead of $module"; |
250 | $module = $guess; | |
251 | } | |
252 | ||
7035e4d3 AC |
253 | if ($info->{CUSTOMIZED}) { |
254 | print <<"EOF"; | |
255 | $module has a CUSTOMIZED entry in Porting/Maintainers.pl. | |
256 | ||
257 | This program's behaviour is to copy every CUSTOMIZED file into the version | |
258 | of the module being imported. But that might not be the right thing: in some | |
259 | cases, the new CPAN version will supersede whatever changes had previously | |
260 | been made in blead, so it would be better to import the new CPAN files. | |
261 | ||
262 | If you've checked that the CUSTOMIZED versions are still correct, you can | |
263 | proceed now. Otherwise, you should abort and investigate the situation. If | |
264 | the blead customizations are no longer needed, delete the CUSTOMIZED entry | |
265 | for $module in Porting/Maintainers.pl (and you'll also need to regenerate | |
266 | t/porting/customized.dat in that case; see t/porting/customized.t). | |
267 | ||
268 | EOF | |
269 | print "Hit return to continue; ^C to abort "; <STDIN>; | |
270 | } | |
271 | ||
418f4069 | 272 | my $distribution = $$info {DISTRIBUTION}; |
b5bf278a A |
273 | |
274 | my @files = glob $$info {FILES}; | |
b7e2b692 | 275 | if (!-d $files [0] || grep { $_ eq $module } @problematic) { |
b5bf278a A |
276 | say "This looks like a setup $0 cannot handle (yet)"; |
277 | unless ($force) { | |
278 | say "Will not continue without a --force option"; | |
279 | exit 1; | |
280 | } | |
281 | say "--force is in effect, so we'll soldier on. Wish me luck!"; | |
282 | } | |
283 | ||
84709797 FC |
284 | use Cwd 'cwd'; |
285 | my $orig_pwd = cwd(); | |
b5bf278a A |
286 | |
287 | chdir "cpan"; | |
288 | ||
83d3dd1d | 289 | my $pkg_dir = $files[0]; |
418f4069 A |
290 | $pkg_dir =~ s!.*/!!; |
291 | ||
87a7cbad | 292 | my ($old_version) = $distribution =~ /-([0-9.]+(?:-TRIAL[0-9]*)?)\.tar\.gz/; |
418f4069 | 293 | |
fea97686 FC |
294 | sub wget { |
295 | my ($url, $saveas) = @_; | |
55d756db | 296 | my $ht_res; |
fea97686 | 297 | eval { |
34c20093 JK |
298 | require IO::Socket::SSL; |
299 | require Net::SSLeay; | |
fea97686 | 300 | require HTTP::Tiny; |
55d756db S |
301 | my $http = HTTP::Tiny->new(); |
302 | $ht_res = $http->mirror( $url => $saveas ); | |
303 | 1; | |
fea97686 | 304 | } or |
55d756db | 305 | # Try harder to download the file |
fea97686 FC |
306 | # Some system do not have wget. Fall back to curl if we do not |
307 | # have it. On Windows, `which wget` is not going to work, so | |
308 | # just use wget, as this script has always done. | |
309 | WIN32 || -x substr(`which wget`, 0, -1) | |
310 | ? system wget => $url, '-qO', $saveas | |
311 | : system curl => $url, '-sSo', $saveas; | |
55d756db S |
312 | |
313 | # We were able to use HTTP::Tiny and it didn't have fatal errors, | |
314 | # but we failed the request | |
315 | if ( $ht_res && ! $ht_res->{'success'} ) { | |
316 | die "Cannot retrieve file: $url\n" . | |
317 | sprintf "Status: %s\nReason: %s\nContent: %s\n", | |
318 | map $_ // '(unavailable)', @{$ht_res}{qw< status reason content >}; | |
319 | } | |
fea97686 FC |
320 | } |
321 | ||
418f4069 A |
322 | # |
323 | # Find the information from CPAN. | |
324 | # | |
4d18e0a2 A |
325 | my $new_file; |
326 | my $new_version; | |
d11e2991 | 327 | if (defined $tarball) { |
84709797 | 328 | $tarball = rel2abs( $tarball, $orig_pwd ) ; |
861c6796 AC |
329 | die "Tarball $tarball does not exist\n" if !-e $tarball; |
330 | die "Tarball $tarball is not a plain file\n" if !-f _; | |
d11e2991 AC |
331 | $new_file = $tarball; |
332 | $new_version = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0]; | |
08ee4cf2 AC |
333 | die "Blead and that tarball both have version $new_version of $module\n" |
334 | if $new_version eq $old_version; | |
d11e2991 AC |
335 | } |
336 | else { | |
4d18e0a2 A |
337 | # |
338 | # Poor man's cache | |
339 | # | |
340 | unless (-f $package_file && -M $package_file < 1) { | |
fea97686 | 341 | wget $package_url, $package_file; |
4d18e0a2 A |
342 | } |
343 | ||
382558a5 | 344 | my $cpan_mod = $info->{MAIN_MODULE} // $module; |
cefd15c2 | 345 | open my $fh, '<', $package_file; |
382558a5 | 346 | (my $new_line) = grep {/^\Q$cpan_mod\E /} <$fh> # Yes, this needs a lot of memory |
4d18e0a2 | 347 | or die "Cannot find $cpan_mod on CPAN\n"; |
4d18e0a2 | 348 | (undef, $new_version, my $new_path) = split ' ', $new_line; |
3a4316cc JL |
349 | if (defined $version) { |
350 | $new_path =~ s/-$new_version\./-$version\./; | |
351 | $new_version = $version; | |
352 | } | |
4d18e0a2 A |
353 | $new_file = (split '/', $new_path) [-1]; |
354 | ||
08ee4cf2 AC |
355 | die "The latest version of $module is $new_version, but blead already has it\n" |
356 | if $new_version eq $old_version; | |
357 | ||
499e37eb | 358 | my $url = "https://cpan.metacpan.org/authors/id/$new_path"; |
4d18e0a2 A |
359 | say "Fetching $url"; |
360 | # | |
361 | # Fetch the new distro | |
362 | # | |
fea97686 | 363 | wget $url, $new_file; |
4d18e0a2 | 364 | } |
418f4069 A |
365 | |
366 | my $old_dir = "$pkg_dir-$old_version"; | |
418f4069 A |
367 | |
368 | say "Cleaning out old directory"; | |
369 | system git => 'clean', '-dfxq', $pkg_dir; | |
370 | ||
418f4069 | 371 | say "Unpacking $new_file"; |
5fb91d48 | 372 | Archive::Tar->extract_archive( $new_file ); |
418f4069 | 373 | |
bd4de633 | 374 | (my $new_dir = basename($new_file)) =~ s/\.tar\.gz//; |
3f7808eb | 375 | # ensure 'make' will update all files |
fc134225 MM |
376 | my $t= time; |
377 | for my $file (find_type_f($new_dir)) { | |
b6574671 | 378 | make_writable($file); # for convenience if the user later edits it |
fc134225 MM |
379 | utime($t,$t,$file); |
380 | }; | |
418f4069 A |
381 | |
382 | say "Renaming directories"; | |
383 | rename $pkg_dir => $old_dir; | |
418f4069 | 384 | |
83d3dd1d JL |
385 | say "Creating new package directory"; |
386 | mkdir $pkg_dir; | |
387 | ||
388 | say "Populating new package directory"; | |
389 | my $map = $$info {MAP}; | |
390 | my @EXCLUDED_QR; | |
391 | my %EXCLUDED_QQ; | |
392 | if ($$info {EXCLUDED}) { | |
393 | foreach my $entry (@{$$info {EXCLUDED}}) { | |
394 | if (ref $entry) {push @EXCLUDED_QR => $entry} | |
395 | else {$EXCLUDED_QQ {$entry} = 1} | |
396 | } | |
397 | } | |
398 | ||
fc134225 | 399 | FILE: for my $file ( find_type_f( $new_dir )) { |
83d3dd1d | 400 | my $old_file = $file; |
ddda34bc | 401 | $file =~ s{^\Q$new_dir\E/}{}; |
83d3dd1d JL |
402 | |
403 | next if $EXCLUDED_QQ{$file}; | |
404 | for my $qr (@EXCLUDED_QR) { | |
405 | next FILE if $file =~ $qr; | |
406 | } | |
407 | ||
408 | if ( $map ) { | |
409 | for my $key ( sort { length $b <=> length $a } keys %$map ) { | |
410 | my $val = $map->{$key}; | |
411 | last if $file =~ s/^$key/$val/; | |
412 | } | |
413 | } | |
7bbb137d JL |
414 | else { |
415 | $file = $files[0] . '/' . $file; | |
416 | } | |
83d3dd1d JL |
417 | |
418 | if ( $file =~ m{^cpan/} ) { | |
419 | $file =~ s{^cpan/}{}; | |
420 | } | |
421 | else { | |
422 | $file = '../' . $file; | |
423 | } | |
424 | ||
425 | my $prefix = ''; | |
426 | my @parts = split '/', $file; | |
427 | pop @parts; | |
428 | for my $part (@parts) { | |
429 | $prefix .= '/' if $prefix; | |
430 | $prefix .= $part; | |
431 | mkdir $prefix unless -d $prefix; | |
432 | } | |
433 | ||
434 | rename $old_file => $file; | |
435 | } | |
192f56b0 | 436 | remove_tree( $new_dir ); |
418f4069 A |
437 | |
438 | if (-f "$old_dir/.gitignore") { | |
439 | say "Restoring .gitignore"; | |
440 | system git => 'checkout', "$pkg_dir/.gitignore"; | |
441 | } | |
442 | ||
fc134225 | 443 | my @new_files = find_type_f( $pkg_dir ); |
418f4069 A |
444 | @new_files = grep {$_ ne $pkg_dir} @new_files; |
445 | s!^[^/]+/!! for @new_files; | |
446 | my %new_files = map {$_ => 1} @new_files; | |
447 | ||
fc134225 | 448 | my @old_files = find_type_f( $old_dir ); |
418f4069 A |
449 | @old_files = grep {$_ ne $old_dir} @old_files; |
450 | s!^[^/]+/!! for @old_files; | |
451 | my %old_files = map {$_ => 1} @old_files; | |
452 | ||
418f4069 A |
453 | my @delete; |
454 | my @commit; | |
455 | my @gone; | |
418f4069 A |
456 | FILE: |
457 | foreach my $file (@new_files) { | |
458 | next if -d "$pkg_dir/$file"; # Ignore directories. | |
459 | next if $old_files {$file}; # It's already there. | |
460 | if ($IGNORABLE {$file}) { | |
461 | push @delete => $file; | |
462 | next; | |
463 | } | |
418f4069 A |
464 | push @commit => $file; |
465 | } | |
466 | foreach my $file (@old_files) { | |
467 | next if -d "$old_dir/$file"; | |
468 | next if $new_files {$file}; | |
469 | push @gone => $file; | |
470 | } | |
ad9b4e6f A |
471 | |
472 | # | |
473 | # Find all files with an exec bit | |
474 | # | |
fc134225 | 475 | my @exec = find_type_f( $pkg_dir ); |
ad9b4e6f A |
476 | my @de_exec; |
477 | foreach my $file (@exec) { | |
478 | # Remove leading dir | |
479 | $file =~ s!^[^/]+/!!; | |
480 | if ($file =~ m!^t/!) { | |
481 | push @de_exec => $file; | |
482 | next; | |
483 | } | |
484 | # Check to see if the file exists; if it doesn't and doesn't have | |
485 | # the exec bit, remove it. | |
486 | if ($old_files {$file}) { | |
487 | unless (-x "$old_dir/$file") { | |
488 | push @de_exec => $file; | |
489 | } | |
490 | } | |
491 | } | |
418f4069 A |
492 | |
493 | # | |
494 | # No need to change the +x bit on files that will be deleted. | |
495 | # | |
ad9b4e6f | 496 | if (@de_exec && @delete) { |
a9f5d1d4 | 497 | my %delete = map {+"$pkg_dir/$_" => 1} @delete; |
ad9b4e6f | 498 | @de_exec = grep {!$delete {$_}} @de_exec; |
418f4069 A |
499 | } |
500 | ||
e42bf9ad AC |
501 | # |
502 | # Mustn't change the +x bit on files that are whitelisted | |
503 | # | |
504 | if (@de_exec) { | |
54ed4dc4 | 505 | my %permitted = map { (my $x = $_) =~ tr/\n//d; $x => 1 } grep !/^#/, |
e42bf9ad AC |
506 | do { local @ARGV = '../Porting/exec-bit.txt'; <> }; |
507 | @de_exec = grep !$permitted{"cpan/$pkg_dir/$_"}, @de_exec; | |
508 | } | |
509 | ||
418f4069 A |
510 | say "unlink $pkg_dir/$_" for @delete; |
511 | say "git add $pkg_dir/$_" for @commit; | |
512 | say "git rm -f $pkg_dir/$_" for @gone; | |
ad9b4e6f | 513 | say "chmod a-x $pkg_dir/$_" for @de_exec; |
418f4069 A |
514 | |
515 | print "Hit return to continue; ^C to abort "; <STDIN>; | |
516 | ||
517 | unlink "$pkg_dir/$_" for @delete; | |
518 | system git => 'add', "$pkg_dir/$_" for @commit; | |
519 | system git => 'rm', '-f', "$pkg_dir/$_" for @gone; | |
cd9a1714 | 520 | de_exec( "$pkg_dir/$_" ) for @de_exec; |
418f4069 | 521 | |
9c259538 A |
522 | # |
523 | # Restore anything that is customized. | |
524 | # We don't really care whether we've deleted the file - since we | |
525 | # do a git restore, it's going to be resurrected if necessary. | |
526 | # | |
527 | if ($$info {CUSTOMIZED}) { | |
528 | say "Restoring customized files"; | |
529 | foreach my $file (@{$$info {CUSTOMIZED}}) { | |
530 | system git => "checkout", "$pkg_dir/$file"; | |
531 | } | |
532 | } | |
533 | ||
a8121781 | 534 | chdir ".."; |
190c1b3b | 535 | if (@commit || @gone) { |
418f4069 | 536 | say "Fixing MANIFEST"; |
190c1b3b AC |
537 | my $MANIFEST = "MANIFEST"; |
538 | my $MANIFEST_NEW = "$MANIFEST.new"; | |
539 | ||
540 | open my $orig, "<", $MANIFEST | |
541 | or die "Failed to open $MANIFEST for reading: $!\n"; | |
542 | open my $new, ">", $MANIFEST_NEW | |
543 | or die "Failed to open $MANIFEST_NEW for writing: $!\n"; | |
544 | my %gone = map +("cpan/$pkg_dir/$_" => 1), @gone; | |
545 | while (my $line = <$orig>) { | |
546 | my ($file) = $line =~ /^(\S+)/ | |
547 | or die "Can't parse MANIFEST line: $line"; | |
548 | print $new $line if !$gone{$file}; | |
549 | } | |
550 | ||
551 | say $new "cpan/$pkg_dir/$_" for @commit; | |
552 | ||
553 | close $new or die "Can't close $MANIFEST: $!\n"; | |
554 | ||
555 | system $^X => "Porting/manisort", '--quiet', "--output=$MANIFEST", $MANIFEST_NEW; | |
556 | unlink $MANIFEST_NEW | |
557 | or die "Can't delete temporary $MANIFEST_NEW: $!\n"; | |
418f4069 A |
558 | } |
559 | ||
560 | ||
e6e4cae9 | 561 | print "Running a make and saving its output to $MAKE_LOG ... "; |
160daab8 MM |
562 | # Prepare for running (selected) tests |
563 | make 'test-prep'; | |
418f4069 A |
564 | print "done\n"; |
565 | ||
d8a823f4 AC |
566 | # The build system installs code from CPAN dists into the lib/ directory, |
567 | # creating directories as needed. This means that the cleaning-related rules | |
568 | # in the Makefile need to know which directories to clean up. The Makefile | |
569 | # is generated by Configure from Makefile.SH, so *that* file needs the list | |
570 | # of directories. regen/lib_cleanup.pl is capable of automatically updating | |
571 | # the contents of Makefile.SH (and win32/Makefile, which needs similar but | |
572 | # not identical lists of directories), so we can just run that (using the | |
573 | # newly-built Perl, as is done with the regen programs run by "make regen"). | |
574 | # | |
575 | # We do this if any files at all have been added or deleted, regardless of | |
576 | # whether those changes result in any directories being added or deleted, | |
577 | # because the alternative would be to replicate the regen/lib_cleanup.pl | |
578 | # logic here. That's fine, because regen/lib_cleanup.pl is idempotent if run | |
579 | # repeatedly. | |
580 | if (@commit || @gone) { | |
581 | say "Running regen/lib_cleanup.pl to handle potential added/deleted dirs"; | |
215d9c65 | 582 | my $exe_dir = WIN32 ? ".\\" : './'; |
d8a823f4 AC |
583 | system "${exe_dir}perl$Config{_exe}", "-Ilib", "regen/lib_cleanup.pl" |
584 | and die "regen/lib_cleanup.pl failed\n"; | |
585 | } | |
586 | ||
418f4069 A |
587 | # |
588 | # Must clean up, or else t/porting/FindExt.t will fail. | |
730ad6b9 | 589 | # Note that we can always retrieve the original directory with a git checkout. |
418f4069 A |
590 | # |
591 | print "About to clean up; hit return or abort (^C) "; <STDIN>; | |
592 | ||
192f56b0 MM |
593 | remove_tree( "cpan/$old_dir" ); |
594 | unlink "cpan/$new_file" unless $tarball; | |
418f4069 | 595 | |
ad9b4e6f A |
596 | # |
597 | # Run the tests. First the test belonging to the module, followed by the | |
a3815e44 | 598 | # tests in t/porting |
ad9b4e6f | 599 | # |
192f56b0 | 600 | chdir "t"; |
ad9b4e6f | 601 | say "Running module tests"; |
57b5d6e1 | 602 | my @test_files = grep { /\.t$/ } find_type_f( "../cpan/$pkg_dir" ); |
215d9c65 | 603 | my $exe_dir = WIN32 ? "..\\" : './'; |
60f5272c | 604 | my $output = `${exe_dir}perl$Config{_exe} TEST @test_files`; |
ad9b4e6f A |
605 | unless ($output =~ /All tests successful/) { |
606 | say $output; | |
607 | exit 1; | |
608 | } | |
609 | ||
418f4069 | 610 | print "Running tests in t/porting "; |
fc134225 | 611 | my @tests = glob 'porting/*.t'; |
418f4069 A |
612 | chomp @tests; |
613 | my @failed; | |
614 | foreach my $t (@tests) { | |
cefd15c2 MM |
615 | my @not = grep {!/# TODO/ } |
616 | grep { /^not/ } | |
617 | `${exe_dir}perl -I../lib -I.. $t`; | |
418f4069 A |
618 | print @not ? '!' : '.'; |
619 | push @failed => $t if @not; | |
620 | } | |
621 | print "\n"; | |
622 | say "Failed tests: @failed" if @failed; | |
623 | ||
624 | ||
9807c17b JL |
625 | chdir '..'; |
626 | ||
627 | open my $Maintainers_pl, '<', 'Porting/Maintainers.pl'; | |
628 | open my $new_Maintainers_pl, '>', 'Maintainers.pl'; | |
629 | ||
630 | my $found; | |
631 | my $in_mod_section; | |
632 | while (<$Maintainers_pl>) { | |
633 | if (!$found) { | |
634 | if ($in_mod_section) { | |
635 | if (/DISTRIBUTION/) { | |
33c6567b | 636 | if (s/\Q$old_version/$new_version/) { |
9807c17b JL |
637 | $found = 1; |
638 | } | |
639 | } | |
640 | ||
92e8e650 | 641 | if (/^ \}/) { |
9807c17b JL |
642 | $in_mod_section = 0; |
643 | } | |
644 | } | |
645 | ||
ec1d1ba0 | 646 | if (/\Q$module/) { |
9807c17b JL |
647 | $in_mod_section = 1; |
648 | } | |
649 | } | |
650 | ||
651 | print $new_Maintainers_pl $_; | |
652 | } | |
653 | ||
654 | if ($found) { | |
d9d83ea5 | 655 | say "Successfully updated Maintainers.pl"; |
9807c17b JL |
656 | unlink 'Porting/Maintainers.pl'; |
657 | rename 'Maintainers.pl' => 'Porting/Maintainers.pl'; | |
cd9a1714 | 658 | chmod 0755 => 'Porting/Maintainers.pl'; |
9807c17b JL |
659 | } |
660 | else { | |
661 | say "Could not update Porting/Maintainers.pl."; | |
662 | say "Make sure you update this by hand before committing."; | |
663 | } | |
418f4069 | 664 | |
592f3827 | 665 | print <<"EOF"; |
418f4069 | 666 | |
592f3827 AC |
667 | ======================================================================= |
668 | ||
6a587761 | 669 | $module is now at version $new_version |
7b88b133 | 670 | Next, you should run "make minitest" and then "make test". |
592f3827 | 671 | |
7b88b133 RL |
672 | Minitest uses miniperl, which does not support XS modules. The full test |
673 | suite uses perl, which does. Minitest can fail - e.g. if a cpan module | |
31cd1f1d | 674 | has added an XS dependency - even if the full test suite passes just fine. |
7b88b133 RL |
675 | |
676 | Hopefully all will complete successfully, but if not, you can make any | |
592f3827 AC |
677 | changes you need to get the tests to pass. Don't forget that you'll need |
678 | a "CUSTOMIZED" entry in Porting/Maintainers.pl if you change any of the | |
679 | files under cpan/$pkg_dir. | |
680 | ||
7b88b133 RL |
681 | Once all tests pass, you can "git add -u" and "git commit" the changes |
682 | with a message along the lines of "Update Foo::Bar to v1.234". | |
592f3827 AC |
683 | |
684 | EOF | |
418f4069 A |
685 | |
686 | __END__ |