This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
clean up documentation for sync-with-cpan
[perl5.git] / Porting / sync-with-cpan
CommitLineData
33e80a47 1#!/usr/bin/env perl
418f4069 2
c5e3e317
JL
3=head1 NAME
4
5 Porting/sync-with-cpan
6
7=head1 SYNOPSIS
8
9 perl Porting/sync-with-cpan <module>
10
11where <module> is the name it appears in the C<%Modules> hash
12of F<Porting/Maintainers.pl>
13
14=head1 DESCRIPTION
15
16Script to help out with syncing cpan distros.
17
18Does the following:
19
20=over 4
21
22=item *
23
24Fetches the package list from CPAN. Finds the current version of the given
25package. [1]
26
27=item *
28
29Downloads the relevant tarball; unpacks the tarball. [1]
30
31=item *
32
33Clean out the old directory (C<git clean -dfx>)
34
35=item *
36
37Moves the old directory out of the way, moves the new directory in place.
38
39=item *
40
41Restores any F<.gitignore> file.
42
43=item *
44
45Removes files from C<@IGNORE> and C<EXCLUDED>
46
47=item *
48
49C<git add> any new files.
50
51=item *
52
53C<git rm> any files that are gone.
54
55=item *
56
57Remove the +x bit on files in F<t/>
58
59=item *
60
61Remove the +x bit on files that don't have it enabled in the current dir
62
63=item *
64
65Restore files mentioned in C<CUSTOMIZED>
66
67=item *
68
69Adds new files to F<MANIFEST>
70
71=item *
72
73Runs a C<make> (assumes a configure has been run)
74
75=item *
76
77Cleans up
78
79=item *
80
81Runs tests for the package
82
83=item *
84
85Runs the porting tests
86
87=back
88
89[1] If the C<--tarball> option is given, then CPAN is not consulted.
90C<--tarball> should be the path to the tarball; the version is extracted
91from the filename -- but can be overwritten by the C<--version> option.
92
93=head1 TODO
94
95=over 4
96
97=item *
98
99Delete files from F<MANIFEST>
100
101=item *
102
103Update F<Porting/Maintainers.pl>
104
105=item *
106
107Optional, run a full test suite
108
109=item *
110
111Handle complicated C<FILES>
112
113=back
114
115This is an initial version; no attempt has been made yet to make this
116portable. It shells out instead of trying to find a Perl solution.
117In particular, it assumes wget, git, tar, chmod, perl, make, and rm
118to be available.
119
120=cut
121
418f4069 122
4d18e0a2
A
123package Maintainers;
124
418f4069
A
125use 5.010;
126
127use strict;
128use warnings;
4d18e0a2 129use Getopt::Long;
418f4069
A
130no warnings 'syntax';
131
132$| = 1;
133
134die "This does not like top level directory"
135 unless -d "cpan" && -d "Porting";
136
418f4069
A
137our @IGNORABLE;
138our %Modules;
139
140use autodie;
141
142require "Porting/Maintainers.pl";
143
418f4069
A
144my %IGNORABLE = map {$_ => 1} @IGNORABLE;
145
146my $package = "02packages.details.txt";
147my $package_url = "http://www.cpan.org/modules/$package";
148my $package_file = "/tmp/$package";
149
418f4069 150
4d18e0a2 151GetOptions ('tarball=s' => \my $tarball,
b5bf278a
A
152 'version=s' => \my $version,
153 force => \my $force,)
4d18e0a2
A
154 or die "Failed to parse arguments";
155
156die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
418f4069 157
5b73aae5
A
158my ($module) = shift;
159my $cpan_mod = @ARGV ? shift : $module;
418f4069 160
4d18e0a2 161
418f4069
A
162my $info = $Modules {$module} or die "Cannot find module $module";
163my $distribution = $$info {DISTRIBUTION};
b5bf278a
A
164
165my @files = glob $$info {FILES};
166if (@files != 1 || !-d $files [0] || $$info {MAP}) {
167 say "This looks like a setup $0 cannot handle (yet)";
168 unless ($force) {
169 say "Will not continue without a --force option";
170 exit 1;
171 }
172 say "--force is in effect, so we'll soldier on. Wish me luck!";
173}
174
175
176chdir "cpan";
177
418f4069
A
178my $pkg_dir = $$info {FILES};
179 $pkg_dir =~ s!.*/!!;
180
181my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
182
183my $o_module = $module;
5b73aae5
A
184if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
185 $cpan_mod =~ s/-/::/g;
418f4069
A
186}
187
188#
189# Find the information from CPAN.
190#
4d18e0a2
A
191my $new_file;
192my $new_version;
193unless ($tarball) {
194 #
195 # Poor man's cache
196 #
197 unless (-f $package_file && -M $package_file < 1) {
198 system wget => $package_url, '-qO', $package_file;
199 }
200
201 my $new_line = `grep '^$cpan_mod ' $package_file`
202 or die "Cannot find $cpan_mod on CPAN\n";
203 chomp $new_line;
204 (undef, $new_version, my $new_path) = split ' ', $new_line;
205 $new_file = (split '/', $new_path) [-1];
206
207 my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
208 say "Fetching $url";
209 #
210 # Fetch the new distro
211 #
212 system wget => $url, '-qO', $new_file;
213}
214else {
215 $new_file = $tarball;
216 $new_version = $version // ($new_file =~ /-([0-9._]+)\.tar\.gz/) [0];
217}
418f4069
A
218
219my $old_dir = "$pkg_dir-$old_version";
220my $new_dir = "$pkg_dir-$new_version";
221
222say "Cleaning out old directory";
223system git => 'clean', '-dfxq', $pkg_dir;
224
418f4069
A
225say "Unpacking $new_file";
226
227system tar => 'xfz', $new_file;
228
229say "Renaming directories";
230rename $pkg_dir => $old_dir;
231rename $new_dir => $pkg_dir;
232
233
234if (-f "$old_dir/.gitignore") {
235 say "Restoring .gitignore";
236 system git => 'checkout', "$pkg_dir/.gitignore";
237}
238
ad9b4e6f 239my @new_files = `find $pkg_dir -type f`;
418f4069
A
240chomp @new_files;
241@new_files = grep {$_ ne $pkg_dir} @new_files;
242s!^[^/]+/!! for @new_files;
243my %new_files = map {$_ => 1} @new_files;
244
ad9b4e6f 245my @old_files = `find $old_dir -type f`;
418f4069
A
246chomp @old_files;
247@old_files = grep {$_ ne $old_dir} @old_files;
248s!^[^/]+/!! for @old_files;
249my %old_files = map {$_ => 1} @old_files;
250
251#
252# Find files that can be deleted.
253#
254my @EXCLUDED_QR;
255my %EXCLUDED_QQ;
256if ($$info {EXCLUDED}) {
257 foreach my $entry (@{$$info {EXCLUDED}}) {
258 if (ref $entry) {push @EXCLUDED_QR => $entry}
259 else {$EXCLUDED_QQ {$entry} = 1}
260 }
261}
262
263my @delete;
264my @commit;
265my @gone;
418f4069
A
266FILE:
267foreach my $file (@new_files) {
268 next if -d "$pkg_dir/$file"; # Ignore directories.
269 next if $old_files {$file}; # It's already there.
270 if ($IGNORABLE {$file}) {
271 push @delete => $file;
272 next;
273 }
274 if ($EXCLUDED_QQ {$file}) {
275 push @delete => $file;
276 next;
277 }
278 foreach my $pattern (@EXCLUDED_QR) {
279 if ($file =~ /$pattern/) {
280 push @delete => $file;
281 next FILE;
282 }
283 }
284 push @commit => $file;
285}
286foreach my $file (@old_files) {
287 next if -d "$old_dir/$file";
288 next if $new_files {$file};
289 push @gone => $file;
290}
ad9b4e6f
A
291
292#
293# Find all files with an exec bit
294#
295my @exec = `find $pkg_dir -type f -perm +111`;
418f4069 296chomp @exec;
ad9b4e6f
A
297my @de_exec;
298foreach my $file (@exec) {
299 # Remove leading dir
300 $file =~ s!^[^/]+/!!;
301 if ($file =~ m!^t/!) {
302 push @de_exec => $file;
303 next;
304 }
305 # Check to see if the file exists; if it doesn't and doesn't have
306 # the exec bit, remove it.
307 if ($old_files {$file}) {
308 unless (-x "$old_dir/$file") {
309 push @de_exec => $file;
310 }
311 }
312}
418f4069
A
313
314#
315# No need to change the +x bit on files that will be deleted.
316#
ad9b4e6f 317if (@de_exec && @delete) {
a9f5d1d4 318 my %delete = map {+"$pkg_dir/$_" => 1} @delete;
ad9b4e6f 319 @de_exec = grep {!$delete {$_}} @de_exec;
418f4069
A
320}
321
322say "unlink $pkg_dir/$_" for @delete;
323say "git add $pkg_dir/$_" for @commit;
324say "git rm -f $pkg_dir/$_" for @gone;
ad9b4e6f 325say "chmod a-x $pkg_dir/$_" for @de_exec;
418f4069
A
326
327print "Hit return to continue; ^C to abort "; <STDIN>;
328
329unlink "$pkg_dir/$_" for @delete;
330system git => 'add', "$pkg_dir/$_" for @commit;
331system git => 'rm', '-f', "$pkg_dir/$_" for @gone;
ad9b4e6f 332system chmod => 'a-x', "$pkg_dir/$_" for @de_exec;
418f4069 333
9c259538
A
334#
335# Restore anything that is customized.
336# We don't really care whether we've deleted the file - since we
337# do a git restore, it's going to be resurrected if necessary.
338#
339if ($$info {CUSTOMIZED}) {
340 say "Restoring customized files";
341 foreach my $file (@{$$info {CUSTOMIZED}}) {
342 system git => "checkout", "$pkg_dir/$file";
343 }
344}
345
a8121781 346chdir "..";
418f4069
A
347if (@commit) {
348 say "Fixing MANIFEST";
a8121781 349 my $MANIFEST = "MANIFEST";
418f4069
A
350 my $MANIFEST_SORT = "$MANIFEST.sorted";
351 open my $fh, ">>", $MANIFEST;
a8121781 352 say $fh "cpan/$pkg_dir/$_" for @commit;
418f4069 353 close $fh;
a8121781 354 system perl => "Porting/manisort", '--output', $MANIFEST_SORT;
418f4069
A
355 rename $MANIFEST_SORT => $MANIFEST;
356}
357
358
418f4069
A
359print "Running a make ... ";
360system "make > make.log 2>&1" and die "Running make failed, see make.log";
361print "done\n";
362
363#
364# Must clean up, or else t/porting/FindExt.t will fail.
365# Note that we can always retrieve the orginal directory with a git checkout.
366#
367print "About to clean up; hit return or abort (^C) "; <STDIN>;
368
369chdir "cpan";
370system rm => '-r', $old_dir;
e81fec2c 371unlink $new_file unless $tarball;
418f4069
A
372
373
ad9b4e6f
A
374#
375# Run the tests. First the test belonging to the module, followed by the
376# the tests in t/porting
377#
418f4069 378chdir "../t";
ad9b4e6f
A
379say "Running module tests";
380my @test_files = `find ../cpan/$pkg_dir -name '*.t' -type f`;
381chomp @test_files;
382my $output = `./perl TEST @test_files`;
383unless ($output =~ /All tests successful/) {
384 say $output;
385 exit 1;
386}
387
418f4069
A
388print "Running tests in t/porting ";
389my @tests = `ls porting/*.t`;
390chomp @tests;
391my @failed;
392foreach my $t (@tests) {
393 my @not = `./perl -I../lib -I.. $t | grep ^not | grep -v "# TODO"`;
394 print @not ? '!' : '.';
395 push @failed => $t if @not;
396}
397print "\n";
398say "Failed tests: @failed" if @failed;
399
400
401print "Now you ought to run a make; make test ...\n";
402
403say "Do not forget to update Porting/Maintainers.pl before committing";
404say "$o_module is now version $new_version";
405
406
407__END__