This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Some backslashes turn out not to be always there.
[perl5.git] / Porting / sync-with-cpan
CommitLineData
418f4069
A
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/
ad9b4e6f 17# - Remove the +x bit on files that don't have in enabled in the current dir
9c259538 18# - Restore files mentioned in CUSTOMIZED
418f4069
A
19# - Adds new files to MANIFEST
20# - Runs a "make" (assumes a configure has been run)
21# - Cleans up
ad9b4e6f 22# - Runs tests for the package
418f4069
A
23# - Runs the porting tests
24#
9c259538 25# TODO: - Delete files from MANIFEST
418f4069 26# - Update Porting/Maintainers.pl
418f4069 27# - Optional, run a full test suite
6f865444 28# - Handle complicated FILES
418f4069
A
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
40use 5.010;
41
42use strict;
43use warnings;
44no warnings 'syntax';
45
46$| = 1;
47
48die "This does not like top level directory"
49 unless -d "cpan" && -d "Porting";
50
51package Maintainers;
52
53our @IGNORABLE;
54our %Modules;
55
56use autodie;
57
58require "Porting/Maintainers.pl";
59
60chdir "cpan";
61
62my %IGNORABLE = map {$_ => 1} @IGNORABLE;
63
64my $package = "02packages.details.txt";
65my $package_url = "http://www.cpan.org/modules/$package";
66my $package_file = "/tmp/$package";
67
68#
69# Poor man's cache
70#
71unless (-f $package_file && -M $package_file < 1) {
72 system wget => $package_url, '-qO', $package_file;
73}
74
5b73aae5 75die "Usage: $0 module [cpan package]" unless @ARGV == 1 || @ARGV == 2;
418f4069 76
5b73aae5
A
77my ($module) = shift;
78my $cpan_mod = @ARGV ? shift : $module;
418f4069
A
79
80my $info = $Modules {$module} or die "Cannot find module $module";
81my $distribution = $$info {DISTRIBUTION};
82my $pkg_dir = $$info {FILES};
83 $pkg_dir =~ s!.*/!!;
84
85my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
86
87my $o_module = $module;
5b73aae5
A
88if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
89 $cpan_mod =~ s/-/::/g;
418f4069
A
90}
91
92#
93# Find the information from CPAN.
94#
5b73aae5
A
95my $new_line = `grep '^$cpan_mod ' $package_file`
96 or die "Cannot find $cpan_mod on CPAN\n";
418f4069
A
97chomp $new_line;
98my (undef, $new_version, $new_path) = split ' ', $new_line;
99my $new_file = (split '/', $new_path) [-1];
100
101my $old_dir = "$pkg_dir-$old_version";
102my $new_dir = "$pkg_dir-$new_version";
103
104say "Cleaning out old directory";
105system git => 'clean', '-dfxq', $pkg_dir;
106
107
108
109my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
110
111say "Fetching $url";
112
113#
114# Fetch the new distro
115#
116system wget => $url, '-qO', $new_file;
117
118say "Unpacking $new_file";
119
120system tar => 'xfz', $new_file;
121
122say "Renaming directories";
123rename $pkg_dir => $old_dir;
124rename $new_dir => $pkg_dir;
125
126
127if (-f "$old_dir/.gitignore") {
128 say "Restoring .gitignore";
129 system git => 'checkout', "$pkg_dir/.gitignore";
130}
131
ad9b4e6f 132my @new_files = `find $pkg_dir -type f`;
418f4069
A
133chomp @new_files;
134@new_files = grep {$_ ne $pkg_dir} @new_files;
135s!^[^/]+/!! for @new_files;
136my %new_files = map {$_ => 1} @new_files;
137
ad9b4e6f 138my @old_files = `find $old_dir -type f`;
418f4069
A
139chomp @old_files;
140@old_files = grep {$_ ne $old_dir} @old_files;
141s!^[^/]+/!! for @old_files;
142my %old_files = map {$_ => 1} @old_files;
143
144#
145# Find files that can be deleted.
146#
147my @EXCLUDED_QR;
148my %EXCLUDED_QQ;
149if ($$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
156my @delete;
157my @commit;
158my @gone;
418f4069
A
159FILE:
160foreach 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}
179foreach my $file (@old_files) {
180 next if -d "$old_dir/$file";
181 next if $new_files {$file};
182 push @gone => $file;
183}
ad9b4e6f
A
184
185#
186# Find all files with an exec bit
187#
188my @exec = `find $pkg_dir -type f -perm +111`;
418f4069 189chomp @exec;
ad9b4e6f
A
190my @de_exec;
191foreach 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}
418f4069
A
206
207#
208# No need to change the +x bit on files that will be deleted.
209#
ad9b4e6f 210if (@de_exec && @delete) {
a9f5d1d4 211 my %delete = map {+"$pkg_dir/$_" => 1} @delete;
ad9b4e6f 212 @de_exec = grep {!$delete {$_}} @de_exec;
418f4069
A
213}
214
215say "unlink $pkg_dir/$_" for @delete;
216say "git add $pkg_dir/$_" for @commit;
217say "git rm -f $pkg_dir/$_" for @gone;
ad9b4e6f 218say "chmod a-x $pkg_dir/$_" for @de_exec;
418f4069
A
219
220print "Hit return to continue; ^C to abort "; <STDIN>;
221
222unlink "$pkg_dir/$_" for @delete;
223system git => 'add', "$pkg_dir/$_" for @commit;
224system git => 'rm', '-f', "$pkg_dir/$_" for @gone;
ad9b4e6f 225system chmod => 'a-x', "$pkg_dir/$_" for @de_exec;
418f4069 226
9c259538
A
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#
232if ($$info {CUSTOMIZED}) {
233 say "Restoring customized files";
234 foreach my $file (@{$$info {CUSTOMIZED}}) {
235 system git => "checkout", "$pkg_dir/$file";
236 }
237}
238
a8121781 239chdir "..";
418f4069
A
240if (@commit) {
241 say "Fixing MANIFEST";
a8121781 242 my $MANIFEST = "MANIFEST";
418f4069
A
243 my $MANIFEST_SORT = "$MANIFEST.sorted";
244 open my $fh, ">>", $MANIFEST;
a8121781 245 say $fh "cpan/$pkg_dir/$_" for @commit;
418f4069 246 close $fh;
a8121781 247 system perl => "Porting/manisort", '--output', $MANIFEST_SORT;
418f4069
A
248 rename $MANIFEST_SORT => $MANIFEST;
249}
250
251
418f4069
A
252print "Running a make ... ";
253system "make > make.log 2>&1" and die "Running make failed, see make.log";
254print "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#
260print "About to clean up; hit return or abort (^C) "; <STDIN>;
261
262chdir "cpan";
263system rm => '-r', $old_dir;
264unlink $new_file;
265
266
ad9b4e6f
A
267#
268# Run the tests. First the test belonging to the module, followed by the
269# the tests in t/porting
270#
418f4069 271chdir "../t";
ad9b4e6f
A
272say "Running module tests";
273my @test_files = `find ../cpan/$pkg_dir -name '*.t' -type f`;
274chomp @test_files;
275my $output = `./perl TEST @test_files`;
276unless ($output =~ /All tests successful/) {
277 say $output;
278 exit 1;
279}
280
418f4069
A
281print "Running tests in t/porting ";
282my @tests = `ls porting/*.t`;
283chomp @tests;
284my @failed;
285foreach 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}
290print "\n";
291say "Failed tests: @failed" if @failed;
292
293
294print "Now you ought to run a make; make test ...\n";
295
296say "Do not forget to update Porting/Maintainers.pl before committing";
297say "$o_module is now version $new_version";
298
299
300__END__