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