1#!/usr/bin/env perl 2 3=head1 NAME 4 5Porting/sync-with-cpan - Synchronize with CPAN distributions 6 7=head1 SYNOPSIS 8 9 sh ./Configure 10 perl Porting/sync-with-cpan <module> 11 12where C<module> is the name it appears in the C<%Modules> hash 13of F<Porting/Maintainers.pl> 14 15=head1 DESCRIPTION 16 17Script to help out with syncing cpan distros. 18 19Does the following: 20 21=over 4 22 23=item * 24 25Fetches the package list from CPAN. Finds the current version of the given 26package. [1] 27 28=item * 29 30Downloads the relevant tarball; unpacks the tarball. [1] 31 32=item * 33 34Clean out the old directory (C<git clean -dfx>) 35 36=item * 37 38Moves the old directory out of the way, moves the new directory in place. 39 40=item * 41 42Restores any F<.gitignore> file. 43 44=item * 45 46Removes files from C<@IGNORE> and C<EXCLUDED> 47 48=item * 49 50C<git add> any new files. 51 52=item * 53 54C<git rm> any files that are gone. 55 56=item * 57 58Remove the +x bit on files in F<t/> 59 60=item * 61 62Remove the +x bit on files that don't have it enabled in the current dir 63 64=item * 65 66Restore files mentioned in C<CUSTOMIZED> 67 68=item * 69 70Updates the contents of F<MANIFEST> 71 72=item * 73 74Runs a C<make> (assumes a configure has been run) 75 76=item * 77 78Cleans up 79 80=item * 81 82Runs tests for the package 83 84=item * 85 86Runs the porting tests 87 88=back 89 90[1] If the C<--tarball> option is given, then CPAN is not consulted. 91C<--tarball> should be the path to the tarball; the version is extracted 92from the filename -- but can be overwritten by the C<--version> option. 93 94=head1 OPTIONS 95 96=over 4 97 98=item C<--jobs> I<N> 99 100When running C<make>, pass a C<< -jI<N> >> option to it to enable 101parallel building. 102 103Note that you can also set C<< TEST_JOBS=I<N> >> in the environment 104to enable parallel *testing* on top of parallel *building*. 105 106=item C<--yes> 107 108Just continue at all places where we would normally ask for the user 109to hit enter or hit CTL-C, with the exception of cases related to 110CUSTOMIZED distributions, where this option will cause the update to 111exit immediately unless the C<--force> option has also been used. 112 113=item C<--force> 114 115Do things we normally would refuse to do. 116 117=item C<--tarball> 118 119Use a predownloaded tarball and not one from CPAN. Example: 120 121 perl Porting/sync-with-cpan Text-Tabs+Wrap \ 122 --tarball /tmp/Text-Tabs+Wrap-2024.001.tar.gz \ 123 --yes 124 125=item C<--version> 126 127Sync with a specific version, not the latest on CPAN. 128 129=item C<--no-test> 130 131=item C<--nt> 132 133Do not run tests. This is helpful for bulk updates. 134 135=item C<--help> 136 137Show help. 138 139=back 140 141=head1 TODO 142 143=over 4 144 145=item * 146 147Update F<Porting/Maintainers.pl> 148 149=item * 150 151Optional, run a full test suite 152 153=item * 154 155Handle complicated C<FILES> 156 157=back 158 159This is an initial version; no attempt has been made yet to make this 160portable. It shells out instead of trying to find a Perl solution. 161In particular, it assumes git, perl, and make 162to be available. 163 164=cut 165 166 167package Maintainers; 168 169use 5.010; 170 171use strict; 172use warnings; 173use Getopt::Long; 174use Archive::Tar; 175use File::Basename qw( basename ); 176use File::Path qw( remove_tree ); 177use File::Find; 178use File::Spec::Functions qw( tmpdir rel2abs ); 179use Config qw( %Config ); 180 181$| = 1; 182 183use constant WIN32 => $^O eq 'MSWin32'; 184 185die "This does not look like a top level directory" 186 unless -d "cpan" && -d "Porting"; 187 188# Check that there's a Makefile, if needed; otherwise, we'll do most of our 189# work only to fail when we try to run make, and the user will have to 190# either unpick everything we've done, or do the rest manually. 191die "Please run Configure before using $0\n" 192 if !WIN32 && !-f "Makefile"; 193 194#these are populated by Porting/Maintainers.pl 195our @IGNORABLE; 196our %Modules; 197our %DistName; 198 199use autodie; 200 201require "./Porting/Maintainers.pl"; 202 203my $MAKE_LOG = 'make.log'; 204unlink $MAKE_LOG if -e $MAKE_LOG; 205 206my %IGNORABLE = map {$_ => 1} @IGNORABLE; 207 208my $tmpdir = tmpdir(); 209 210my $package = "02packages.details.txt"; 211my $package_url = "http://www.cpan.org/modules/$package"; 212my $package_file = "$tmpdir/$package"; # this is a cache 213my $type_dir = "cpan"; 214 215my @problematic = ( 216 # no current entries as of perl-5.40.1 (Jan 2025) 217); 218 219 220sub usage 221{ 222 my $err = shift and select STDERR; 223 print "Usage: $0 <module-or-dist> [args]\n"; 224 exit $err; 225} 226 227GetOptions ('tarball=s' => \my $tarball, 228 'version=s' => \my $version, 229 'jobs=i' => \my $make_jobs, 230 'yes' => \my $yes_to_all, 231 'force' => \my $force, 232 'no-test|nt' => \my $no_test, 233 'help' => sub { usage 0; }, 234 'type=s' => \$type_dir, 235 ) or die "Failed to parse arguments"; 236 237usage 1 unless @ARGV == 1; 238 239sub find_type_f { 240 my @res; 241 find( { no_chdir => 1, wanted => sub { 242 my $file= $File::Find::name; 243 return unless -f $file; 244 push @res, $file 245 }}, @_ ); 246 @res 247}; 248 249# Equivalent of `chmod a-x` 250sub de_exec { 251 my ($filename) = @_; 252 my $mode = (stat $filename)[2] & 0777; 253 if ($mode & 0111) { # exec-bit set 254 chmod $mode & 0666, $filename; 255 } 256} 257 258# Equivalent of `chmod +w` 259sub make_writable { 260 my ($filename) = @_; 261 my $mode = (stat $filename)[2] & 0777; 262 if (!($mode & 0222)) { # not writable 263 chmod $mode | (0222 & ~umask), $filename; 264 } 265} 266 267my $SEP_LINE = ("-" x 79) . "\n"; 268 269sub cat_make_log { 270 my ($message) = @_; 271 print $message, $message=~/Starting/ 272 ? " and saving its output to '$MAKE_LOG' ...\n" 273 : "\n"; 274 275 open my $ofh, ">>", $MAKE_LOG 276 or die "Failed to open '$MAKE_LOG' for append\n"; 277 print $ofh $SEP_LINE,"$message at ", 278 scalar(localtime),"\n",$SEP_LINE; 279 close $ofh; 280} 281 282sub run_make { 283 my @args = @_; 284 unshift @args, "-j$make_jobs" if defined $make_jobs; 285 cat_make_log("Starting `make @args`"); 286 my $errored; 287 if (WIN32) { 288 chdir "Win32"; 289 $errored = system "$Config{make} @args >> ..\\$MAKE_LOG 2>&1"; 290 chdir '..'; 291 } else { 292 $errored = system "$Config{make} @args >> $MAKE_LOG 2>&1"; 293 }; 294 cat_make_log("Finished `make @args`"); 295 if ($errored) { 296 if ($args[0] ne "test-prep") { 297 # see if we can extract the last Test Summary Report from 298 # the $MAKE_LOG file, 299 if (open my $ifh, "<", $MAKE_LOG) { 300 my @report; 301 my $in_summary; 302 while (<$ifh>) { 303 if (/^Test Summary Report/) { 304 @report = (); 305 $in_summary = 1; 306 } elsif ($_ eq $SEP_LINE) { 307 $in_summary = 0; 308 } 309 push @report, $_ if $in_summary; 310 } 311 print for @report; 312 } else { 313 warn "Failed to open $MAKE_LOG for reading: $!"; 314 } 315 } 316 die "Running `make` failed, see '$MAKE_LOG' for more details\n"; 317 } 318} 319 320sub pause_for_input { 321 my ($after_message) = @_; 322 print "Hit <return> to continue; ^C to abort "; 323 if ($yes_to_all) { 324 print "\n--yes was used on command line, continuing.\n"; 325 } else { 326 my $noop = <STDIN>; 327 } 328 print $after_message if $after_message; 329} 330 331my ($module) = shift @ARGV; 332if (my $mod_name = $DistName{$module}) { 333 $module = $mod_name; 334} 335my $info = $Modules{$module}; 336if (!$info) { 337 # Maybe the user said "Test-Simple" instead of "Test::Simple", or 338 # "IO::Compress" instead of "IO-Compress". See if we can fix it up. 339 my $guess = $module; 340 s/-/::/g or s/::/-/g for $guess; 341 $info = $Modules{$guess} or die <<"EOF"; 342Cannot find module $module. 343The available options are listed in the %Modules hash in Porting/Maintainers.pl 344EOF 345 say "Guessing you meant $guess instead of $module"; 346 $module = $guess; 347} 348 349if ($info->{CUSTOMIZED}) { 350 print <<"EOF"; 351$module has a CUSTOMIZED entry in Porting/Maintainers.pl. 352 353This program's behaviour is to copy every CUSTOMIZED file into the version 354of the module being imported. But that might not be the right thing: in some 355cases, the new CPAN version will supersede whatever changes had previously 356been made in blead, so it would be better to import the new CPAN files. 357 358If you've checked that the CUSTOMIZED versions are still correct, you can 359proceed now. Otherwise, you should abort and investigate the situation. If 360the blead customizations are no longer needed, delete the CUSTOMIZED entry 361for $module in Porting/Maintainers.pl (and you'll also need to regenerate 362t/porting/customized.dat in that case; see t/porting/customized.t). 363 364EOF 365 if ($yes_to_all and !$force) { 366 die "This distribution is marked as CUSTOMIZED\n", 367 "You used --yes on the command line, but without --force.\n", 368 "Bailing out. Use --force to go ahead anyway.\n"; 369 } 370 pause_for_input("\n"); 371} 372 373if (!$ENV{TEST_JOBS} and !WIN32) { 374 print "*** NOTE *** For speedups you can set TEST_JOBS=N in the env before running this script.\n"; 375} 376if (!$make_jobs and !WIN32) { 377 print "*** NOTE *** For speedups you can pass --jobs=N as an arg to this script.\n" 378} 379print "About to clean the $type_dir/ directory, and ensure its contents is up to date.\n"; 380print "Will also checkout -f on $type_dir/, MANIFEST and Porting/Maintainers.pl\n"; 381print "*** WARNING *** - this may DELETE uncommitted changes. Hit ^C if you have ANY doubts!\n"; 382pause_for_input("\n"); 383# clean out the cpan directory, this cleans up any temporary files that might be 384# in the way, or other issues that might come up if the user bails out of the sync 385# script and then runs it again. 386my $clean_out= `git clean -dfx $type_dir`; # use backticks to hide the output 387system git => 'checkout', '-f', 388 $type_dir, 389 'MANIFEST', 390 'Porting/Maintainers.pl'; # let the user see the output 391print "the $type_dir/ directory is now clean and up to date\n---\n"; 392 393my $distribution = $$info {DISTRIBUTION}; 394 395my @files = glob $$info {FILES}; 396if (!-d $files [0] || grep { $_ eq $module } @problematic) { 397 say "This looks like a setup $0 cannot handle (yet)"; 398 unless ($force) { 399 say "Will not continue without a --force option"; 400 exit 1; 401 } 402 say "--force is in effect, so we'll soldier on. Wish me luck!"; 403} 404 405use Cwd 'cwd'; 406my $orig_pwd = cwd(); 407 408chdir "$type_dir"; 409 410my $pkg_dir = $files[0]; 411 $pkg_dir =~ s!.*/!!; 412 413my $tail_pat = qr/\.(?:tar\.(?:g?z|bz2|Z)|zip|tgz|tbz)/; 414my $version_pat = qr/-v?([0-9._]+(?:-TRIAL[0-9]*)?)$tail_pat\z/; 415 416my ($old_version) = $distribution =~ $version_pat; 417 418if (!$old_version) { 419 die "WTF: failed to parse old version from '$distribution'\n"; 420} 421 422sub wget { 423 my ($url, $saveas) = @_; 424 my $ht_res; 425 eval { 426 require IO::Socket::SSL; 427 require Net::SSLeay; 428 require HTTP::Tiny; 429 my $http = HTTP::Tiny->new(); 430 $ht_res = $http->mirror( $url => $saveas ); 431 1; 432 } or 433 # Try harder to download the file 434 # Some system do not have wget. Fall back to curl if we do not 435 # have it. On Windows, `which wget` is not going to work, so 436 # just use wget, as this script has always done. 437 WIN32 || -x substr(`which wget`, 0, -1) 438 ? system wget => $url, '-qO', $saveas 439 : system curl => $url, '-sSo', $saveas; 440 441 # We were able to use HTTP::Tiny and it didn't have fatal errors, 442 # but we failed the request 443 if ( $ht_res && ! $ht_res->{'success'} ) { 444 die "Cannot retrieve file: $url\n" . 445 sprintf "Status: %s\nReason: %s\nContent: %s\n", 446 map $_ // '(unavailable)', @{$ht_res}{qw< status reason content >}; 447 } 448} 449 450# 451# Find the information from CPAN. 452# 453my $new_file; 454my $new_version; 455my $re_update = ""; 456if (defined $tarball) { 457 $tarball = rel2abs( $tarball, $orig_pwd ) ; 458 die "Tarball $tarball does not exist\n" if !-e $tarball; 459 die "Tarball $tarball is not a plain file\n" if !-f _; 460 $new_file = $tarball; 461 $new_version = $version // ($new_file =~ $version_pat) [0]; 462 die "Blead and that tarball both have version $new_version of $module\n" 463 if $new_version eq $old_version; 464} 465else { 466 # 467 # Poor man's cache 468 # 469 unless (-f $package_file && -M $package_file < 1) { 470 wget $package_url, $package_file; 471 } 472 473 my $cpan_mod = $info->{MAIN_MODULE} // $module; 474 open my $fh, '<', $package_file; 475 (my $new_line) = grep {/^\Q$cpan_mod\E /} <$fh> # Yes, this needs a lot of memory 476 or die "Cannot find $cpan_mod on CPAN\n"; 477 (undef, $new_version, my $new_path) = split ' ', $new_line; 478 if (defined $version) { 479 $new_path =~ s/-$new_version\./-$version\./; 480 $new_version = $version; 481 } 482 $new_file = (split '/', $new_path) [-1]; 483 484 if ($old_version eq $new_version) { 485 $re_update = "Re-"; 486 print "The latest version of $module is $new_version, but blead already has it.\n"; 487 print "Continuing may update MANIFEST or other metadata so it may make sense to continue anyway.\n"; 488 print "Are you sure you want to continue?\n"; 489 pause_for_input(); 490 } 491 492 my $url = "https://cpan.metacpan.org/authors/id/$new_path"; 493 say "Fetching $url"; 494 # 495 # Fetch the new distro 496 # 497 wget $url, $new_file; 498} 499 500my $old_dir = "$pkg_dir-$old_version-OLD"; 501 502say "Cleaning out old directory"; 503system git => 'clean', '-dfxq', $pkg_dir; 504 505say "Unpacking $new_file"; 506Archive::Tar->extract_archive( $new_file ); 507 508(my $new_dir = basename($new_file)) =~ s/$tail_pat\z//; 509# ensure 'make' will update all files 510my $t= time; 511for my $file (find_type_f($new_dir)) { 512 make_writable($file); # for convenience if the user later edits it 513 utime($t,$t,$file); 514}; 515 516say "Renaming directories"; 517rename $pkg_dir => $old_dir; 518 519say "Creating new package directory"; 520mkdir $pkg_dir; 521 522say "Populating new package directory"; 523my $map = $$info {MAP}; 524my @EXCLUDED_QR; 525my %EXCLUDED_QQ; 526if ($$info {EXCLUDED}) { 527 foreach my $entry (@{$$info {EXCLUDED}}) { 528 if (ref $entry) {push @EXCLUDED_QR => $entry} 529 else {$EXCLUDED_QQ {$entry} = 1} 530 } 531} 532 533FILE: for my $file ( find_type_f( $new_dir )) { 534 my $old_file = $file; 535 $file =~ s{^\Q$new_dir\E/}{}; 536 537 next if $EXCLUDED_QQ{$file}; 538 for my $qr (@EXCLUDED_QR) { 539 next FILE if $file =~ $qr; 540 } 541 542 if ( $map ) { 543 for my $key ( sort { length $b <=> length $a } keys %$map ) { 544 my $val = $map->{$key}; 545 last if $file =~ s/^$key/$val/; 546 } 547 } 548 else { 549 $file = $files[0] . '/' . $file; 550 } 551 552 if ( $file =~ m{^$type_dir/} ) { 553 $file =~ s{^$type_dir/}{}; 554 } 555 else { 556 $file = '../' . $file; 557 } 558 559 my $prefix = ''; 560 my @parts = split '/', $file; 561 pop @parts; 562 for my $part (@parts) { 563 $prefix .= '/' if $prefix; 564 $prefix .= $part; 565 mkdir $prefix unless -d $prefix; 566 } 567 568 rename $old_file => $file; 569} 570remove_tree( $new_dir ); 571 572if (-f "$old_dir/.gitignore") { 573 say "Restoring .gitignore"; 574 system git => 'checkout', "$pkg_dir/.gitignore"; 575} 576 577my @new_files = find_type_f( $pkg_dir ); 578@new_files = grep {$_ ne $pkg_dir} @new_files; 579s!^[^/]+/!! for @new_files; 580my %new_files = map {$_ => 1} @new_files; 581 582my @old_files = find_type_f( $old_dir ); 583@old_files = grep {$_ ne $old_dir} @old_files; 584s!^[^/]+/!! for @old_files; 585my %old_files = map {$_ => 1} @old_files; 586 587my @delete; 588my @commit; 589my @gone; 590my $changes_file; 591FILE: 592foreach my $file (@new_files) { 593 next if -d "$pkg_dir/$file"; # Ignore directories. 594 next if $old_files {$file}; # It's already there. 595 if ($file=~/Changes/i or $file=~/Changelog/) { 596 if ($changes_file) { 597 die "More than one changes file? $file and $changes_file both exist?"; 598 } 599 $changes_file = "$pkg_dir/$file"; 600 } 601 if ($IGNORABLE {$file}) { 602 push @delete => $file; 603 next; 604 } 605 push @commit => $file; 606} 607foreach my $file (@old_files) { 608 next if -d "$old_dir/$file"; 609 next if $new_files {$file}; 610 push @gone => $file; 611} 612 613my @changes_info; 614if (!$changes_file) { 615 print "Could not find a changes file!\n", 616 "If this is not correct and there is one, please consider updating this script!\n"; 617} else { 618 open my $ifh, "<", $changes_file 619 or die "Failed to open '$changes_file':$!"; 620 chomp(my @lines = <$ifh>); 621 close $ifh; 622 my $seen_new_version; 623 my $is_update = $new_version ne $old_version; 624 625 for(my $idx = 0; $idx < @lines; $idx++) { 626 if ($lines[$idx] =~ /$new_version/ || 627 ($pkg_dir eq "CPAN" and $lines[$idx] =~/^\d{4}-\d{2}-\d{2}/ 628 && $lines[$idx+2] 629 && $lines[$idx+2] =~ /release $new_version/) 630 ){ 631 $seen_new_version = 1; 632 push @changes_info, $lines[$idx]; 633 } elsif ($seen_new_version) { 634 if ($is_update && $pkg_dir eq "ExtUtils-MakeMaker") { 635 if ($lines[$idx] =~/$old_version/) { 636 last; 637 } 638 } 639 elsif (($lines[$idx]=~/\d\.\d/ and $lines[$idx]=~/20\d\d/) || 640 ($lines[$idx]=~/---------------------------------/) || 641 ($pkg_dir eq "CPAN" and $lines[$idx] =~/^\d{4}-\d{2}-\d{2}/) || 642 ($pkg_dir eq "version" and $lines[$idx] =~/^\d\.\d+/) || 643 ($pkg_dir eq "Getopt-Long" and $lines[$idx] =~/Changes in version/) || 644 ($pkg_dir eq "ExtUtils-Install" and $lines[$idx] =~/^\d+\.\d+/) || 645 0 # less commit churn if we have to tweak the heuristics above 646 ){ 647 last; 648 } 649 push @changes_info, $lines[$idx]; 650 651 } 652 } 653 if (!@changes_info) { 654 die "No changes?"; 655 } else { 656 print "Changes from $changes_file\n"; 657 print $_,"\n" for @changes_info; 658 } 659} 660 661# 662# Find all files with an exec bit 663# 664my @exec = find_type_f( $pkg_dir ); 665my @de_exec; 666foreach my $file (@exec) { 667 # Remove leading dir 668 $file =~ s!^[^/]+/!!; 669 if ($file =~ m!^t/!) { 670 push @de_exec => $file; 671 next; 672 } 673 # Check to see if the file exists; if it doesn't and doesn't have 674 # the exec bit, remove it. 675 if ($old_files {$file}) { 676 unless (-x "$old_dir/$file") { 677 push @de_exec => $file; 678 } 679 } 680} 681 682# 683# No need to change the +x bit on files that will be deleted. 684# 685if (@de_exec && @delete) { 686 my %delete = map {+"$pkg_dir/$_" => 1} @delete; 687 @de_exec = grep {!$delete {$_}} @de_exec; 688} 689 690# 691# Mustn't change the +x bit on files that are whitelisted 692# 693if (@de_exec) { 694 my %permitted = map { (my $x = $_) =~ tr/\n//d; $x => 1 } grep !/^#/, 695 do { local @ARGV = '../Porting/exec-bit.txt'; <> }; 696 @de_exec = grep !$permitted{"$type_dir/$pkg_dir/$_"}, @de_exec; 697} 698@$_ = sort @$_ for \@delete, \@commit, \@gone, \@de_exec; 699 700say "unlink $pkg_dir/$_" for @delete; 701say "git add $pkg_dir/$_" for @commit; 702say "git rm -f $pkg_dir/$_" for @gone; 703say "chmod a-x $pkg_dir/$_" for @de_exec; 704 705print "--\nWill perform the above steps and then start testing.\n"; 706print "You may want to `tail -F $MAKE_LOG` in another window\n"; 707pause_for_input("\n"); 708 709unlink "$pkg_dir/$_" for @delete; 710system git => 'add', "$pkg_dir/$_" for @commit; 711system git => 'rm', '-f', "$pkg_dir/$_" for @gone; 712de_exec( "$pkg_dir/$_" ) for @de_exec; 713 714# 715# Restore anything that is customized. 716# We don't really care whether we've deleted the file - since we 717# do a git restore, it's going to be resurrected if necessary. 718# 719if ($$info {CUSTOMIZED}) { 720 say "Restoring customized files"; 721 foreach my $file (@{$$info {CUSTOMIZED}}) { 722 system git => "checkout", "$pkg_dir/$file"; 723 } 724} 725 726chdir ".."; 727{ 728 # we update the MANIFEST file always now, so that we can 729 # ensure each file from this sync is updated to say that we 730 # got it from the latest version. 731 say "Updating the MANIFEST file"; 732 my $MANIFEST = "MANIFEST"; 733 my $MANIFEST_NEW = "$MANIFEST.new"; 734 735 open my $orig, "<", $MANIFEST 736 or die "Failed to open $MANIFEST for reading: $!\n"; 737 open my $new, ">", $MANIFEST_NEW 738 or die "Failed to open $MANIFEST_NEW for writing: $!\n"; 739 my %keep = map +("$type_dir/$pkg_dir/$_" => 1), keys %new_files; 740 my %gone = map +("$type_dir/$pkg_dir/$_" => 1), @gone; 741 while (my $line = <$orig>) { 742 chomp $line; 743 my ($file, $descr) = split /\t+/, $line; 744 if (!$file) { 745 die "Can't parse MANIFEST line: '$line' at line $.\n"; 746 } 747 if ($keep{$file} and !$descr) { 748 # make sure we have at least one tab, old versions of 749 # this script would add lines to MANIFEST with no tab. 750 $line =~ s/^(\S+)\z/$1\t\t/; 751 752 my $file_descr = ""; 753 if ( $file =~ /\.t/ ) { 754 $file_descr = "Test file"; 755 } 756 elsif ( $file =~ /\.pm/ ) { 757 $file_descr = "Module"; 758 } 759 elsif ( $file =~ /\.pl/ ) { 760 $file_descr = "Script"; 761 } 762 $file_descr .= " related to " if $file_descr; 763 # and update the line to show where the file came from. 764 $line =~ s/(\t+).*/$1$file_descr$module/; 765 } 766 say $new $line if !$gone{$file}; 767 } 768 769 say $new "$type_dir/$pkg_dir/$_\t\t$pkg_dir" for @commit; 770 771 close $new or die "Can't close $MANIFEST: $!\n"; 772 773 system $^X => "Porting/manisort", '--quiet', "--output=$MANIFEST", $MANIFEST_NEW; 774 unlink $MANIFEST_NEW 775 or die "Can't delete temporary $MANIFEST_NEW: $!\n"; 776} 777 778 779 780# Prepare for running (selected) tests - strictly speaking this isn't 781# necessary, as we run the tests with "run_make" now, but this allows 782# us to separate build issues from test issues. 783run_make 'test-prep' unless $no_test; 784 785# The build system installs code from CPAN dists into the lib/ directory, 786# creating directories as needed. This means that the cleaning-related rules 787# in the Makefile need to know which directories to clean up. The Makefile 788# is generated by Configure from Makefile.SH, so *that* file needs the list 789# of directories. regen/lib_cleanup.pl is capable of automatically updating 790# the contents of Makefile.SH (and win32/Makefile, which needs similar but 791# not identical lists of directories), so we can just run that (using the 792# newly-built Perl, as is done with the regen programs run by "make regen"). 793# 794# We do this if any files at all have been added or deleted, regardless of 795# whether those changes result in any directories being added or deleted, 796# because the alternative would be to replicate the regen/lib_cleanup.pl 797# logic here. That's fine, because regen/lib_cleanup.pl is idempotent if run 798# repeatedly. 799if (@commit || @gone) { 800 say "Running regen/lib_cleanup.pl to handle potential added/deleted dirs"; 801 my $exe_dir = WIN32 ? ".\\" : './'; 802 system "${exe_dir}perl$Config{_exe}", "-Ilib", "regen/lib_cleanup.pl" 803 and die "regen/lib_cleanup.pl failed\n"; 804} 805 806# 807# Must clean up, or else t/porting/FindExt.t will fail. 808# Note that we can always retrieve the original directory with a git checkout. 809# 810print "About to clean up the old version, update Maintainers.pl and start tests\n"; 811pause_for_input("\n"); 812 813remove_tree( "$type_dir/$old_dir" ); 814unlink "$type_dir/$new_file" unless $tarball; 815 816 817open my $Maintainers_pl, '<', 'Porting/Maintainers.pl'; 818open my $new_Maintainers_pl, '>', 'Maintainers.pl'; 819 820my $found = 0; 821my $in_mod_section; 822while (<$Maintainers_pl>) { 823 if ($in_mod_section) { 824 if ($found == 1) { 825 # Keep track of when and who did the sync. 826 # This must be before the DISTRIBUTION check. 827 # This ensures that *something* is updated when we re-update. 828 my $date = localtime; 829 my $user = $ENV{USER} ? "$ENV{USER} on " : ""; 830 my $key = "SYNCINFO"; 831 if ( /^'([A-Z_]+)'\s+=>/ and $1 eq $key) { 832 s/(=>\s+)'[^']+'/$1'$user$date'/; 833 } 834 else { 835 print $new_Maintainers_pl 836 " '$key' => '$user$date',\n"; 837 } 838 $found = 2; 839 $in_mod_section = 0; 840 } 841 if (/DISTRIBUTION/) { 842 if (s/\Q$old_version/$new_version/) { 843 $found = 1; 844 } 845 } 846 if (/^\s*\}/) { # sanity 847 $in_mod_section = 0; 848 } 849 } 850 851 if (/\Q$module\E/ and !$found) { 852 $in_mod_section = 1; 853 } 854 855 print $new_Maintainers_pl $_; 856} 857 858if ($found) { 859 say "Successfully updated Maintainers.pl"; 860 unlink 'Porting/Maintainers.pl'; 861 rename 'Maintainers.pl' => 'Porting/Maintainers.pl'; 862 chmod 0755 => 'Porting/Maintainers.pl'; 863} 864else { 865 say "Could not update Porting/Maintainers.pl."; 866 say "Make sure you update this by hand before committing."; 867} 868 869# Run the tests. First the test belonging to the module, followed by the 870# tests in t/porting 871 872my $shell_quote = WIN32 ? '"' : "'"; 873if ($no_test) { 874 print "*** NOT RUNNING TESTS ***\n"; 875} else { 876 run_make "test-harness TEST_ARGS=$shell_quote-re $pkg_dir$shell_quote"; 877 run_make "test-porting"; 878} 879 880my $committed; 881if (@changes_info) { 882 system git => 'commit', 883 join("\n", 884 "-m$type_dir/$pkg_dir - ${re_update}Update to version $new_version", 885 "",@changes_info), 886 "$type_dir/$pkg_dir", "MANIFEST", "Porting/Maintainers.pl" 887 or $committed = 1; # note system returns true for an error! 888} 889 890 891print <<"EOF"; 892 893======================================================================= 894 895$module is now at version $new_version 896Next, you should run "make minitest" and then "make test". 897 898Minitest uses miniperl, which does not support XS modules. The full test 899suite uses perl, which does. Minitest can fail - e.g. if a cpan module 900has added an XS dependency - even if the full test suite passes just fine. 901 902Hopefully all will complete successfully, but if not, you can make any 903changes you need to get the tests to pass. Don't forget that you'll need 904a "CUSTOMIZED" entry in Porting/Maintainers.pl if you change any of the 905files under $type_dir/$pkg_dir. 906 907EOF 908 909if ($committed) { 910 print <<"EOF"; 911The changes have already been committed. If the tests above fail you can 912discard this patch with 913 914 git reset --hard HEAD^. 915 916You may also want to review the commit message and alter it with 917 918 git commit --amend 919 920Regardless you still need to push this commit upstream with something like 921 922 git push origin HEAD:$ENV{USER}/update_${pkg_dir}_v_$new_version 923 924EOF 925} else { 926 print <<"EOF"; 927Once all tests pass, you can commit it with a command like: 928 929 git commit -m${shell_quote}$type_dir/$pkg_dir - Update to version $new_version${shell_quote} $type_dir/$pkg_dir 930 931and then push it upstream with a command like 932 933 git push origin HEAD:$ENV{USER}/update_${pkg_dir}_v_$new_version 934 935EOF 936} 937 938__END__ 939