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