In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4387bc3c6899993ec4504edc3be8b5440ea61521?hp=d62e4400a62cae85d546fe1f5b0731630b537851>
- Log ----------------------------------------------------------------- commit 4387bc3c6899993ec4504edc3be8b5440ea61521 Merge: d62e440 cefd15c Author: Max Maischein <[email protected]> Date: Sun Oct 6 21:03:19 2013 +0200 Eliminate reliance on some external tools for 'Porting/sync-with-cpan' This series of patches eliminates the reliance on external tools for Porting/sync-with-cpan . If these changes stand the test of time, similar changes can be applied to other Porting/ tools to reduce the need for external tools. commit cefd15c28021ef0818c51846c60d89cf62b32fc7 Author: Max Maischein <[email protected]> Date: Thu Oct 3 18:48:27 2013 +0200 Elide use of `grep` The new approach uses more memory as it reads the whole 11 MB CPAN packages file into memory. Also, it makes less use of parallel multiprocessing now available on many machines. M Porting/sync-with-cpan commit 160daab816e76fa4243218cc3aace68f382c8e9a Author: Max Maischein <[email protected]> Date: Sat Oct 5 20:01:44 2013 +0200 Run correct make Use Config.pm to determine correct kind of `make` tool For Windows, the make process is supposed to get kicked off in ./Win32. We now run `make test-prep` before trying the module self-tests M Porting/sync-with-cpan commit cd9a17141adacfdd66e379334b50b7516d4f2cec Author: Max Maischein <[email protected]> Date: Sat Oct 5 19:59:11 2013 +0200 Elide use of `chmod` We simplify life here and try to set Porting/Makefile.PL always to mode 755 (u=rwx , ao=rx) instead of being more precise. M Porting/sync-with-cpan commit fc134225747f7f6b1e38daa4f85f3c36c99755ee Author: Max Maischein <[email protected]> Date: Thu Oct 3 18:38:36 2013 +0200 Elide use of `ls`, `find` and `touch` File::Find and code copied from ExtUtils::Command do the same. This patch makes the code to remove the exec bit a little less efficient by not restricting itself to files that now have the exec bit set, but instead looking at all files. This change also uses $ENV{TEMP} in preference to /tmp as a temp directory for caching the CPAN index. M Porting/sync-with-cpan commit 192f56b06136953e14ef490067000185cc351337 Author: Max Maischein <[email protected]> Date: Thu Oct 3 18:17:39 2013 +0200 Elide use of `rm` We remove the reliance on an external 'rm' tool in favour of using File::Path::remove_tree. We also eliminate some dir-changing by using more absolute directory names. M Porting/sync-with-cpan commit 132246f2f9bbbe9b47a59225d9250987fed15100 Author: Max Maischein <[email protected]> Date: Tue May 21 19:11:22 2013 +0200 First try with HTTP::Tiny, fallback on `wget` This tries downloads first with the built-in HTTP::Tiny before it falls back to the external `wget` tool. Arguably, the reliance on `wget` could be eliminated to reduce the amount of code clutter. M Porting/sync-with-cpan ----------------------------------------------------------------------- Summary of changes: Porting/sync-with-cpan | 106 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 77 insertions(+), 29 deletions(-) diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan index c3f9ce1..795fe1b 100755 --- a/Porting/sync-with-cpan +++ b/Porting/sync-with-cpan @@ -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 wget, git, tar, chmod, perl, make, and rm +In particular, it assumes git, perl, and make to be available. =cut @@ -128,6 +128,9 @@ use strict; use warnings; use Getopt::Long; use Archive::Tar; +use File::Path qw( remove_tree ); +use File::Find; +use Config qw( %Config ); $| = 1; @@ -143,9 +146,11 @@ require "Porting/Maintainers.pl"; my %IGNORABLE = map {$_ => 1} @IGNORABLE; +my $tmpdir= $ENV{ TEMP } // '/tmp'; + my $package = "02packages.details.txt"; my $package_url = "http://www.cpan.org/modules/$package";; -my $package_file = "/tmp/$package"; +my $package_file = "$tmpdir/$package"; # this is a cache my @problematic = ( 'podlators', # weird CUSTOMIZED section due to .PL files @@ -159,6 +164,37 @@ GetOptions ('tarball=s' => \my $tarball, die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2; +sub find_type_f { + my @res; + find( { no_chdir => 1, wanted => sub { + my $file= $File::Find::name; + return unless -f $file; + push @res, $file + }}, @_ ); + @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; @@ -199,12 +235,17 @@ unless ($tarball) { # Poor man's cache # unless (-f $package_file && -M $package_file < 1) { - system wget => $package_url, '-qO', $package_file; + eval { + require HTTP::Tiny; + my $http= HTTP::Tiny->new(); + $http->mirror( $package_url => $package_file ); + 1 + } 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\./; @@ -217,7 +258,12 @@ unless ($tarball) { # # Fetch the new distro # - system wget => $url, '-qO', $new_file; + eval { + require HTTP::Tiny; + my $http= HTTP::Tiny->new(); + $http->mirror( $url => $new_file ); + 1 + } or system wget => $url, '-qO', $new_file; } else { $new_file = $tarball; @@ -234,7 +280,12 @@ Archive::Tar->extract_archive( $new_file ); (my $new_dir = $new_file) =~ s/\.tar\.gz//; # ensure 'make' will update all files -system('find', $new_dir, '-exec', 'touch', '{}', ';'); +my $t= time; +for my $file (find_type_f($new_dir)) { + open(my $fh,">>$file") || die "Cannot write $file:$!"; + close($fh); + utime($t,$t,$file); +}; say "Renaming directories"; rename $pkg_dir => $old_dir; @@ -253,8 +304,7 @@ if ($$info {EXCLUDED}) { } } -FILE: for my $file ( `find $new_dir -type f` ) { - chomp $file; +FILE: for my $file ( find_type_f( $new_dir )) { my $old_file = $file; $file =~ s{^$new_dir/}{}; @@ -291,21 +341,19 @@ FILE: for my $file ( `find $new_dir -type f` ) { rename $old_file => $file; } -system 'rm', '-rf', $new_dir; +remove_tree( $new_dir ); if (-f "$old_dir/.gitignore") { say "Restoring .gitignore"; system git => 'checkout', "$pkg_dir/.gitignore"; } -my @new_files = `find $pkg_dir -type f`; -chomp @new_files; +my @new_files = find_type_f( $pkg_dir ); @new_files = grep {$_ ne $pkg_dir} @new_files; s!^[^/]+/!! for @new_files; my %new_files = map {$_ => 1} @new_files; -my @old_files = `find $old_dir -type f`; -chomp @old_files; +my @old_files = find_type_f( $old_dir ); @old_files = grep {$_ ne $old_dir} @old_files; s!^[^/]+/!! for @old_files; my %old_files = map {$_ => 1} @old_files; @@ -332,8 +380,7 @@ foreach my $file (@old_files) { # # Find all files with an exec bit # -my @exec = `find $pkg_dir -type f -perm +111`; -chomp @exec; +my @exec = find_type_f( $pkg_dir ); my @de_exec; foreach my $file (@exec) { # Remove leading dir @@ -369,7 +416,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. @@ -397,7 +444,8 @@ if (@commit) { print "Running a make ... "; -system "make > make.log 2>&1" and die "Running make failed, see make.log"; +# Prepare for running (selected) tests +make 'test-prep'; print "done\n"; # @@ -406,31 +454,31 @@ print "done\n"; # print "About to clean up; hit return or abort (^C) "; <STDIN>; -chdir "cpan"; -system rm => '-r', $old_dir; -unlink $new_file unless $tarball; - +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 # -chdir "../t"; +chdir "t"; say "Running module tests"; -my @test_files = `find ../cpan/$pkg_dir -name '*.t' -type f`; -chomp @test_files; -my $output = `./perl TEST @test_files`; +my @test_files = grep { /\.t$/ } find_type_f( $pkg_dir ); +my $exe_dir= $^O =~ /MSWin/ ? "..\\" : './'; +my $output = `${exe_dir}perl$Config{_exe} TEST @test_files`; unless ($output =~ /All tests successful/) { say $output; exit 1; } print "Running tests in t/porting "; -my @tests = `ls porting/*.t`; +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; } @@ -471,7 +519,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."; -- Perl5 Master Repository
