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);