This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
update sync-with-cpan to handle dists with MAPped files
[perl5.git] / Porting / sync-with-cpan
1 #!/usr/bin/env perl
2
3 =head1 NAME
4
5 Porting/sync-with-cpan
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 Adds new files to 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 TODO
94
95 =over 4
96
97 =item *
98
99 Delete files from F<MANIFEST>
100
101 =item *
102
103 Update F<Porting/Maintainers.pl>
104
105 =item *
106
107 Optional, run a full test suite
108
109 =item *
110
111 Handle complicated C<FILES>
112
113 =back
114
115 This is an initial version; no attempt has been made yet to make this
116 portable. It shells out instead of trying to find a Perl solution.
117 In particular, it assumes wget, git, tar, chmod, perl, make, and rm
118 to be available.
119
120 =cut
121
122
123 package Maintainers;
124
125 use 5.010;
126
127 use strict;
128 use warnings;
129 use Getopt::Long;
130
131 $| = 1;
132
133 die "This does not look like a top level directory"
134      unless -d "cpan" && -d "Porting";
135
136 our @IGNORABLE;
137 our %Modules;
138
139 use autodie;
140
141 require "Porting/Maintainers.pl";
142
143 my %IGNORABLE    = map {$_ => 1} @IGNORABLE;
144
145 my $package      = "02packages.details.txt";
146 my $package_url  = "http://www.cpan.org/modules/$package";
147 my $package_file = "/tmp/$package";
148
149
150 GetOptions ('tarball=s'  =>  \my $tarball,
151             'version=s'  =>  \my $version,
152              force       =>  \my $force,)
153         or  die "Failed to parse arguments";
154
155 die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
156
157 my ($module)  = shift;
158 my  $cpan_mod = @ARGV ? shift : $module;
159
160
161 my  $info         = $Modules {$module} or die "Cannot find module $module";
162 my  $distribution = $$info {DISTRIBUTION};
163
164 my @files         = glob $$info {FILES};
165 if (!-d $files [0]) {
166     say "This looks like a setup $0 cannot handle (yet)";
167     unless ($force) {
168         say "Will not continue without a --force option";
169         exit 1;
170     }
171     say "--force is in effect, so we'll soldier on. Wish me luck!";
172 }
173
174
175 chdir "cpan";
176
177 my  $pkg_dir      = $files[0];
178     $pkg_dir      =~ s!.*/!!;
179
180 my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
181
182 my  $o_module     = $module;
183 if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
184     $cpan_mod =~ s/-/::/g;
185 }
186
187 #
188 # Find the information from CPAN.
189 #
190 my $new_file;
191 my $new_version;
192 unless ($tarball) {
193     #
194     # Poor man's cache
195     #
196     unless (-f $package_file && -M $package_file < 1) {
197         system wget => $package_url, '-qO', $package_file;
198     }
199
200     my  $new_line = `grep '^$cpan_mod ' $package_file`
201                      or die "Cannot find $cpan_mod on CPAN\n";
202     chomp $new_line;
203     (undef, $new_version, my $new_path) = split ' ', $new_line;
204     if (defined $version) {
205         $new_path =~ s/-$new_version\./-$version\./;
206         $new_version = $version;
207     }
208     $new_file = (split '/', $new_path) [-1];
209
210     my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
211     say "Fetching $url";
212     #
213     # Fetch the new distro
214     #
215     system wget => $url, '-qO', $new_file;
216 }
217 else {
218     $new_file     = $tarball;
219     $new_version  = $version // ($new_file =~ /-([0-9._]+)\.tar\.gz/) [0];
220 }
221
222 my  $old_dir      = "$pkg_dir-$old_version";
223
224 say "Cleaning out old directory";
225 system git => 'clean', '-dfxq', $pkg_dir;
226
227 say "Unpacking $new_file";
228
229 system tar => 'xfz', $new_file;
230 (my $new_dir = $new_file) =~ s/\.tar\.gz//;
231 # ensure 'make' will update all files
232 system('find', $new_dir, '-exec', 'touch', '{}', ';');
233
234 say "Renaming directories";
235 rename $pkg_dir => $old_dir;
236
237 say "Creating new package directory";
238 mkdir $pkg_dir;
239
240 say "Populating new package directory";
241 my $map = $$info {MAP};
242 my @EXCLUDED_QR;
243 my %EXCLUDED_QQ;
244 if ($$info {EXCLUDED}) {
245     foreach my $entry (@{$$info {EXCLUDED}}) {
246         if (ref $entry) {push @EXCLUDED_QR => $entry}
247         else            {$EXCLUDED_QQ {$entry} = 1}
248     }
249 }
250
251 FILE: for my $file ( `find $new_dir -type f` ) {
252     chomp $file;
253     my $old_file = $file;
254     $file =~ s{^$new_dir/}{};
255
256     next if $EXCLUDED_QQ{$file};
257     for my $qr (@EXCLUDED_QR) {
258         next FILE if $file =~ $qr;
259     }
260
261     if ( $map ) {
262         for my $key ( sort { length $b <=> length $a } keys %$map ) {
263             my $val = $map->{$key};
264             last if $file =~ s/^$key/$val/;
265         }
266     }
267
268     if ( $file =~ m{^cpan/} ) {
269         $file =~ s{^cpan/}{};
270     }
271     else {
272         $file = '../' . $file;
273     }
274
275     my $prefix = '';
276     my @parts = split '/', $file;
277     pop @parts;
278     for my $part (@parts) {
279         $prefix .= '/' if $prefix;
280         $prefix .= $part;
281         mkdir $prefix unless -d $prefix;
282     }
283
284     rename $old_file => $file;
285 }
286 system 'rm', '-rf', $new_dir;
287
288 if (-f "$old_dir/.gitignore") {
289     say "Restoring .gitignore";
290     system git => 'checkout', "$pkg_dir/.gitignore";
291 }
292
293 my @new_files = `find $pkg_dir -type f`;
294 chomp @new_files;
295 @new_files = grep {$_ ne $pkg_dir} @new_files;
296 s!^[^/]+/!! for @new_files;
297 my %new_files = map {$_ => 1} @new_files;
298
299 my @old_files = `find $old_dir -type f`;
300 chomp @old_files;
301 @old_files = grep {$_ ne $old_dir} @old_files;
302 s!^[^/]+/!! for @old_files;
303 my %old_files = map {$_ => 1} @old_files;
304
305 my @delete;
306 my @commit;
307 my @gone;
308 FILE:
309 foreach my $file (@new_files) {
310     next if -d "$pkg_dir/$file";   # Ignore directories.
311     next if $old_files {$file};    # It's already there.
312     if ($IGNORABLE {$file}) {
313         push @delete => $file;
314         next;
315     }
316     push @commit => $file;
317 }
318 foreach my $file (@old_files) {
319     next if -d "$old_dir/$file";
320     next if $new_files {$file};
321     push @gone => $file;
322 }
323
324 #
325 # Find all files with an exec bit
326 #
327 my @exec = `find $pkg_dir -type f -perm +111`;
328 chomp @exec;
329 my @de_exec;
330 foreach my $file (@exec) {
331     # Remove leading dir
332     $file =~ s!^[^/]+/!!;
333     if ($file =~ m!^t/!) {
334         push @de_exec => $file;
335         next;
336     }
337     # Check to see if the file exists; if it doesn't and doesn't have
338     # the exec bit, remove it.
339     if ($old_files {$file}) {
340         unless (-x "$old_dir/$file") {
341             push @de_exec => $file;
342         }
343     }
344 }
345
346 #
347 # No need to change the +x bit on files that will be deleted.
348 #
349 if (@de_exec && @delete) {
350     my %delete = map {+"$pkg_dir/$_" => 1} @delete;
351     @de_exec = grep {!$delete {$_}} @de_exec;
352 }
353
354 say "unlink $pkg_dir/$_" for @delete;
355 say "git add $pkg_dir/$_" for @commit;
356 say "git rm -f $pkg_dir/$_" for @gone;
357 say "chmod a-x $pkg_dir/$_" for @de_exec;
358
359 print "Hit return to continue; ^C to abort "; <STDIN>;
360
361 unlink "$pkg_dir/$_"                      for @delete;
362 system git   => 'add', "$pkg_dir/$_"      for @commit;
363 system git   => 'rm', '-f', "$pkg_dir/$_" for @gone;
364 system chmod => 'a-x', "$pkg_dir/$_"      for @de_exec;
365
366 #
367 # Restore anything that is customized.
368 # We don't really care whether we've deleted the file - since we
369 # do a git restore, it's going to be resurrected if necessary.
370 #
371 if ($$info {CUSTOMIZED}) {
372     say "Restoring customized files";
373     foreach my $file (@{$$info {CUSTOMIZED}}) {
374         system git => "checkout", "$pkg_dir/$file";
375     }
376 }
377
378 chdir "..";
379 if (@commit) {
380     say "Fixing MANIFEST";
381     my $MANIFEST      = "MANIFEST";
382     my $MANIFEST_SORT = "$MANIFEST.sorted";
383     open my $fh, ">>", $MANIFEST;
384     say $fh "cpan/$pkg_dir/$_" for @commit;
385     close $fh;
386     system perl => "Porting/manisort", '--output', $MANIFEST_SORT;
387     rename $MANIFEST_SORT => $MANIFEST;
388 }
389
390
391 print "Running a make ... ";
392 system "make > make.log 2>&1" and die "Running make failed, see make.log";
393 print "done\n";
394
395 #
396 # Must clean up, or else t/porting/FindExt.t will fail.
397 # Note that we can always retrieve the orginal directory with a git checkout.
398 #
399 print "About to clean up; hit return or abort (^C) "; <STDIN>;
400
401 chdir "cpan";
402 system rm => '-r', $old_dir;
403 unlink $new_file unless $tarball;
404
405
406 #
407 # Run the tests. First the test belonging to the module, followed by the
408 # the tests in t/porting
409 #
410 chdir "../t";
411 say "Running module tests";
412 my @test_files = `find ../cpan/$pkg_dir -name '*.t' -type f`;
413 chomp @test_files;
414 my $output = `./perl TEST @test_files`;
415 unless ($output =~ /All tests successful/) {
416     say $output;
417     exit 1;
418 }
419
420 print "Running tests in t/porting ";
421 my @tests = `ls porting/*.t`;
422 chomp @tests;
423 my @failed;
424 foreach my $t (@tests) {
425     my @not = `./perl -I../lib -I.. $t | grep ^not | grep -v "# TODO"`;
426     print @not ? '!' : '.';
427     push @failed => $t if @not;
428 }
429 print "\n";
430 say "Failed tests: @failed" if @failed;
431
432
433 print "Now you ought to run a make; make test ...\n";
434
435 say "Do not forget to update Porting/Maintainers.pl before committing";
436 say "$o_module is now version $new_version";
437
438
439 __END__