Porting/sync-with-cpan

   1 #!/usr/bin/env 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. [1]
   9 #    - Downloads the relevant tarball; unpacks the tarball;. [1]
  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 # [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 #
  29 # TODO:  - Delete files from MANIFEST
  30 #        - Update Porting/Maintainers.pl
  31 #        - Optional, run a full test suite
  32 #        - Handle complicated FILES
  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
  44 package Maintainers;
  45
  46 use 5.010;
  47
  48 use strict;
  49 use warnings;
  50 use Getopt::Long;
  51 no  warnings 'syntax';
  52
  53 $| = 1;
  54
  55 die "This does not like top level directory"
  56      unless -d "cpan" && -d "Porting";
  57
  58 our @IGNORABLE;
  59 our %Modules;
  60
  61 use autodie;
  62
  63 require "Porting/Maintainers.pl";
  64
  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
  71
  72 GetOptions ('tarball=s'  =>  \my $tarball,
  73             'version=s'  =>  \my $version,
  74              force       =>  \my $force,)
  75         or  die "Failed to parse arguments";
  76
  77 die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
  78
  79 my ($module)  = shift;
  80 my  $cpan_mod = @ARGV ? shift : $module;
  81
  82
  83 my  $info         = $Modules {$module} or die "Cannot find module $module";
  84 my  $distribution = $$info {DISTRIBUTION};
  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
  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;
 105 if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
 106     $cpan_mod =~ s/-/::/g;
 107 }
 108
 109 #
 110 # Find the information from CPAN.
 111 #
 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 }
 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
 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
 160 my @new_files = `find $pkg_dir -type f`;
 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
 166 my @old_files = `find $old_dir -type f`;
 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;
 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 }
 212
 213 #
 214 # Find all files with an exec bit
 215 #
 216 my @exec = `find $pkg_dir -type f -perm +111`;
 217 chomp @exec;
 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 }
 234
 235 #
 236 # No need to change the +x bit on files that will be deleted.
 237 #
 238 if (@de_exec && @delete) {
 239     my %delete = map {+"$pkg_dir/$_" => 1} @delete;
 240     @de_exec = grep {!$delete {$_}} @de_exec;
 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;
 246 say "chmod a-x $pkg_dir/$_" for @de_exec;
 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;
 253 system chmod => 'a-x', "$pkg_dir/$_"      for @de_exec;
 254
 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
 267 chdir "..";
 268 if (@commit) {
 269     say "Fixing MANIFEST";
 270     my $MANIFEST      = "MANIFEST";
 271     my $MANIFEST_SORT = "$MANIFEST.sorted";
 272     open my $fh, ">>", $MANIFEST;
 273     say $fh "cpan/$pkg_dir/$_" for @commit;
 274     close $fh;
 275     system perl => "Porting/manisort", '--output', $MANIFEST_SORT;
 276     rename $MANIFEST_SORT => $MANIFEST;
 277 }
 278
 279
 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;
 292 unlink $new_file unless $tarball;
 293
 294
 295 #
 296 # Run the tests. First the test belonging to the module, followed by the
 297 # the tests in t/porting
 298 #
 299 chdir "../t";
 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
 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__