Commit | Line | Data |
---|---|---|
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 | ||
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 | ||
5b73aae5 | 75 | die "Usage: $0 module [cpan package]" unless @ARGV == 1 || @ARGV == 2; |
418f4069 | 76 | |
5b73aae5 A |
77 | my ($module) = shift; |
78 | my $cpan_mod = @ARGV ? shift : $module; | |
418f4069 A |
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; | |
5b73aae5 A |
88 | if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) { |
89 | $cpan_mod =~ s/-/::/g; | |
418f4069 A |
90 | } |
91 | ||
92 | # | |
93 | # Find the information from CPAN. | |
94 | # | |
5b73aae5 A |
95 | my $new_line = `grep '^$cpan_mod ' $package_file` |
96 | or die "Cannot find $cpan_mod on CPAN\n"; | |
418f4069 A |
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 | ||
ad9b4e6f | 132 | my @new_files = `find $pkg_dir -type f`; |
418f4069 A |
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 | ||
ad9b4e6f | 138 | my @old_files = `find $old_dir -type f`; |
418f4069 A |
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; | |
418f4069 A |
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 | } | |
ad9b4e6f A |
184 | |
185 | # | |
186 | # Find all files with an exec bit | |
187 | # | |
188 | my @exec = `find $pkg_dir -type f -perm +111`; | |
418f4069 | 189 | chomp @exec; |
ad9b4e6f A |
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 | } | |
418f4069 A |
206 | |
207 | # | |
208 | # No need to change the +x bit on files that will be deleted. | |
209 | # | |
ad9b4e6f | 210 | if (@de_exec && @delete) { |
a9f5d1d4 | 211 | my %delete = map {+"$pkg_dir/$_" => 1} @delete; |
ad9b4e6f | 212 | @de_exec = grep {!$delete {$_}} @de_exec; |
418f4069 A |
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; | |
ad9b4e6f | 218 | say "chmod a-x $pkg_dir/$_" for @de_exec; |
418f4069 A |
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; | |
ad9b4e6f | 225 | system 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 | # | |
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 | ||
a8121781 | 239 | chdir ".."; |
418f4069 A |
240 | if (@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 |
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 | ||
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 | 271 | chdir "../t"; |
ad9b4e6f A |
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 | ||
418f4069 A |
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__ |