1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
#!perl -w
use strict;
require './regen/regen_lib.pl';
require './Porting/pod_lib.pl';
our ($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;
# verify_contiguous() is defined in Porting/pod_lib.pl
$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() is defined in Porting/pod_lib.pl
process('Makefile.SH', 'Makefile.SH', \&edit_makefile_SH, $TAP && '', $Verbose);
foreach ('win32/Makefile', 'win32/GNUmakefile') {
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;
}
if ($ENV{'PERL_BUILD_PACKAGING'}) {
print "ok # skip explicitly disabled git tests by PERL_BUILD_PACKAGING\n";
exit 0;
}
# open_new() is defined in ./regen/regen_lib.pl.
$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() is defined in ./regen/regen_lib.pl.
read_only_bottom_close_and_rename($fh);
|
