Mercurial > repo
diff perl-5.22.2/regen/lib_cleanup.pl @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/perl-5.22.2/regen/lib_cleanup.pl Sat May 14 14:54:38 2016 +0000 @@ -0,0 +1,180 @@ +#!perl -w +use strict; +require 'regen/regen_lib.pl'; +require 'Porting/pod_lib.pl'; +use vars qw($TAP $Verbose); + +# For processing later +my @ext; +# Lookup hash of all directories in lib/ in a clean distribution +my %libdirs; + +open my $fh, '<', 'MANIFEST' + or die "Can't open MANIFEST: $!"; + +while (<$fh>) { + if (m<^((?:cpan|dist|ext)/[^/]+/ # In an extension directory + (?!t/|private/|corpus/|demo/|testdir/) # but not a test or similar + \S+ # filename characters + (?:\.pm|\.pod|_pm\.PL|_pod\.PL|\.yml)) # useful ending + (?:\s|$) # whitespace or end of line + >x) { + push @ext, $1; + } elsif (m!^lib/([^ \t\n]+)/[^/ \t\n]+!) { + # All we are interested in are shipped directories in lib/ + # leafnames (and package names) are actually irrelevant. + my $dirs = $1; + do { + # lib/Pod/t is in MANIFEST, but lib/Pod is not. Rather than + # special-casing this, generalise the code to ensure that all + # parent directories of anything add are also added: + ++$libdirs{$dirs} + } while ($dirs =~ s!/.*!!); + } +} + +close $fh + or die "Can't close MANIFEST: $!"; + +# Lines we need in lib/.gitignore +my %ignore; +# Directories that the Makfiles should remove +# With a special case already :-( +my %rmdir_s = my %rmdir = ('Unicode/Collate/Locale' => 1); + +FILE: +foreach my $file (@ext) { + my ($extname, $path) = $file =~ m!^(?:cpan|dist|ext)/([^/]+)/(.*)! + or die "Can't parse '$file'"; + + if ($path =~ /\.yml$/) { + next unless $path =~ s!^lib/!!; + } elsif ($path =~ /\.pod$/) { + unless ($path =~ s!^lib/!!) { + # ExtUtils::MakeMaker will install it to a path based on the + # extension name: + if ($extname =~ s!-[^-]+$!!) { + $extname =~ tr!-!/!; + $path = "$extname/$path"; + } + } + } elsif ($extname eq 'Unicode-Collate' # Trust the package lines + || $extname eq 'Encode' # Trust the package lines + || $path eq 'win32/Win32.pm' # Trust the package line + || ($path !~ tr!/!! # No path + && $path ne 'DB_File.pm' # ... but has multiple package lines + )) { + # Too many special cases to encode, so just open the file and figure it + # out: + my $package; + open my $fh, '<', $file + or die "Can't open $file: $!"; + while (<$fh>) { + if (/^\s*package\s+([A-Za-z0-9_:]+)/) { + $package = $1; + last; + } + } + close $fh + or die "Can't close $file: $!"; + die "Can't locate package statement in $file" + unless defined $package; + $package =~ s!::!/!g; + $path = "$package.pm"; + } else { + if ($path =~ s/\.PL$//) { + # .PL files generate other files. By convention the output filename + # has the .PL stripped, and any preceding _ changed to ., to comply + # with historical VMS filename rules that only permit one . + $path =~ s!_([^_/]+)$!.$1!; + } + $path =~ s!^lib/!!; + } + my @parts = split '/', $path; + my $prefix = shift @parts; + while (@parts) { + if (!$libdirs{$prefix}) { + # It is a directory that we will create. Ignore everything in it: + ++$ignore{"/$prefix/"}; + ++$rmdir{$prefix}; + ++$rmdir_s{$prefix}; + pop @parts; + while (@parts) { + $prefix .= '/' . shift @parts; + ++$rmdir{$prefix}; + } + next FILE; + } + $prefix .= '/' . shift @parts; + # If we've just shifted the leafname back onto $prefix, then @parts is + # empty, so we should terminate this loop. + } + # We are creating a file in an existing directory. We must ignore the file + # explicitly: + ++$ignore{"/$path"}; +} + +sub edit_makefile_SH { + my ($desc, $contents) = @_; + my $start_re = qr/(\trm -f so_locations[^\n]+)/; + my ($start) = $contents =~ $start_re; + $contents = verify_contiguous($desc, $contents, + qr/$start_re\n(?:\t-rmdir [^\n]+\n)+/sm, + 'lib directory rmdir rules'); + # Reverse sort ensures that any subdirectories are deleted first. + # The extensions themselves delete files with the MakeMaker generated clean + # targets. + $contents =~ s{\0} + {"$start\n" + . wrap(79, "\t-rmdir ", "\t-rmdir ", + map {"lib/$_"} reverse sort keys %rmdir) + . "\n"}e; + $contents; +} + +sub edit_win32_makefile { + my ($desc, $contents) = @_; + my $start = "\t-del /f *.def *.map"; + my $start_re = quotemeta($start); + $contents = verify_contiguous($desc, $contents, + qr!$start_re\n(?:\t-if exist (\$\(LIBDIR\)\\\S+) rmdir /s /q \1\n)+!sm, + 'Win32 lib directory rmdir rules'); + # Win32 is (currently) using rmdir /s /q which deletes recursively + # (seems to be analogous to rm -r) so we don't explicitly list + # subdirectories to delete, and don't need to ensure that subdirectories are + # deleted before their parents. + # Might be able to rely on MakeMaker generated clean targets to clean + # everything, but not in a position to test this. + my $lines = join '', map { + tr!/!\\!; + "\t-if exist \$(LIBDIR)\\$_ rmdir /s /q \$(LIBDIR)\\$_\n" + } sort {lc $a cmp lc $b} keys %rmdir_s; + $contents =~ s/\0/$start\n$lines/; + $contents; +} + +process('Makefile.SH', 'Makefile.SH', \&edit_makefile_SH, $TAP && '', $Verbose); +foreach ('win32/Makefile', 'win32/makefile.mk') { + process($_, $_, \&edit_win32_makefile, $TAP && '', $Verbose); +} + +# This must come last as it can exit early: +if ($TAP && !-d '.git' && !-f 'lib/.gitignore') { + print "ok # skip not being run from a git checkout, hence no lib/.gitignore\n"; + exit 0; +} + +$fh = open_new('lib/.gitignore', '>', + { by => $0, + from => 'MANIFEST and parsing files in cpan/ dist/ and ext/'}); + +print $fh <<"EOT"; +# If this generated file has problems, it may be simpler to add more special +# cases to the top level .gitignore than to code one-off logic into the +# generation script $0 + +EOT + +print $fh "$_\n" foreach sort keys %ignore; + +read_only_bottom_close_and_rename($fh);