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