This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Attribute-Handlers is of the 0.99 on CPAN
[perl5.git] / Porting / sync-with-cpan
index 0fe3733..d0cc1d6 100755 (executable)
@@ -114,7 +114,7 @@ Handle complicated C<FILES>
 
 This is an initial version; no attempt has been made yet to make this
 portable. It shells out instead of trying to find a Perl solution.
-In particular, it assumes git, chmod, perl, and make
+In particular, it assumes git, perl, and make
 to be available.
 
 =cut
@@ -130,6 +130,7 @@ use Getopt::Long;
 use Archive::Tar;
 use File::Path qw( remove_tree );
 use File::Find;
+use Config qw( %Config );
 
 $| = 1;
 
@@ -156,12 +157,20 @@ my @problematic = (
 );
 
 
+sub usage
+{
+    my $err = shift and select STDERR;
+    print "Usage: $0 module [args] [cpan package]\n";
+    exit $err;
+}
+
 GetOptions ('tarball=s'  =>  \my $tarball,
             'version=s'  =>  \my $version,
-             force       =>  \my $force,)
-        or  die "Failed to parse arguments";
+             force       =>  \my $force,
+             help        =>  sub { usage 0; },
+             ) or  die "Failed to parse arguments";
 
-die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
+usage 1 unless @ARGV == 1 || @ARGV == 2;
 
 sub find_type_f {
     my @res;
@@ -173,6 +182,27 @@ sub find_type_f {
     @res
 };
 
+# Equivalent of `chmod a-x`
+sub de_exec {
+    for my $filename ( @_ ) {
+        my $mode= (stat $filename)[2] & 0777;
+        if( $mode & 0111 ) { # exec-bit set
+            chmod $mode & 0666, $filename;
+        };
+    }
+}
+
+sub make {
+    my @args= @_;
+    if( $^O eq 'MSWin32') {
+        chdir "Win32";
+        system "$Config{make} @args> ..\\make.log 2>&1" and die "Running make failed, see make.log";
+        chdir '..';
+    } else {
+        system "$Config{make} @args> make.log 2>&1" and die "Running make failed, see make.log";
+    };
+};
+
 my ($module)  = shift;
 my  $cpan_mod = @ARGV ? shift : $module;
 
@@ -196,7 +226,7 @@ chdir "cpan";
 my  $pkg_dir      = $files[0];
     $pkg_dir      =~ s!.*/!!;
 
-my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
+my ($old_version) = $distribution =~ /-([0-9.]+(?:-TRIAL[0-9]*)?)\.tar\.gz/;
 
 my  $o_module     = $module;
 if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
@@ -221,9 +251,9 @@ unless ($tarball) {
         } or system wget => $package_url, '-qO', $package_file;
     }
 
-    my  $new_line = `grep '^$cpan_mod ' $package_file`
+    open my $fh, '<', $package_file;
+    (my $new_line) = grep {/^$cpan_mod/} <$fh> # Yes, this needs a lot of memory
                      or die "Cannot find $cpan_mod on CPAN\n";
-    chomp $new_line;
     (undef, $new_version, my $new_path) = split ' ', $new_line;
     if (defined $version) {
         $new_path =~ s/-$new_version\./-$version\./;
@@ -245,7 +275,7 @@ unless ($tarball) {
 }
 else {
     $new_file     = $tarball;
-    $new_version  = $version // ($new_file =~ /-([0-9._]+)\.tar\.gz/) [0];
+    $new_version  = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0];
 }
 
 my  $old_dir      = "$pkg_dir-$old_version";
@@ -394,7 +424,7 @@ print "Hit return to continue; ^C to abort "; <STDIN>;
 unlink "$pkg_dir/$_"                      for @delete;
 system git   => 'add', "$pkg_dir/$_"      for @commit;
 system git   => 'rm', '-f', "$pkg_dir/$_" for @gone;
-system chmod => 'a-x', "$pkg_dir/$_"      for @de_exec;
+de_exec( "$pkg_dir/$_" )                  for @de_exec;
 
 #
 # Restore anything that is customized.
@@ -422,7 +452,8 @@ if (@commit) {
 
 
 print "Running a make ... ";
-system "$Config{make} > make.log 2>&1" and die "Running make failed, see make.log";
+# Prepare for running (selected) tests
+make 'test-prep';
 print "done\n";
 
 #
@@ -434,7 +465,6 @@ print "About to clean up; hit return or abort (^C) "; <STDIN>;
 remove_tree( "cpan/$old_dir" );
 unlink "cpan/$new_file" unless $tarball;
 
-
 #
 # Run the tests. First the test belonging to the module, followed by the
 # the tests in t/porting
@@ -454,7 +484,9 @@ my @tests = glob 'porting/*.t';
 chomp @tests;
 my @failed;
 foreach my $t (@tests) {
-    my @not = `./perl -I../lib -I.. $t | grep ^not | grep -v "# TODO"`;
+    my @not = grep {!/# TODO/ }
+              grep { /^not/ }
+              `${exe_dir}perl -I../lib -I.. $t`;
     print @not ? '!' : '.';
     push @failed => $t if @not;
 }
@@ -495,7 +527,7 @@ while (<$Maintainers_pl>) {
 if ($found) {
     unlink 'Porting/Maintainers.pl';
     rename 'Maintainers.pl' => 'Porting/Maintainers.pl';
-    system chmod => 'a+x', 'Porting/Maintainers.pl';
+    chmod 0755 => 'Porting/Maintainers.pl';
 }
 else {
     say "Could not update Porting/Maintainers.pl.";