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