xref: /openbsd-src/gnu/usr.bin/perl/Porting/sync-with-cpan (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
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