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