Commit | Line | Data |
---|---|---|
e275ec0e NC |
1 | #!perl -w |
2 | use strict; | |
3d7c117d MB |
3 | require './regen/regen_lib.pl'; |
4 | require './Porting/pod_lib.pl'; | |
e64a0c47 | 5 | our ($TAP, $Verbose); |
e275ec0e NC |
6 | |
7 | # For processing later | |
8 | my @ext; | |
9 | # Lookup hash of all directories in lib/ in a clean distribution | |
10 | my %libdirs; | |
11 | ||
12 | open my $fh, '<', 'MANIFEST' | |
13 | or die "Can't open MANIFEST: $!"; | |
14 | ||
15 | while (<$fh>) { | |
16 | if (m<^((?:cpan|dist|ext)/[^/]+/ # In an extension directory | |
17 | (?!t/|private/|corpus/|demo/|testdir/) # but not a test or similar | |
18 | \S+ # filename characters | |
727d4ce6 | 19 | (?:\.pm|\.pod|_pm\.PL|_pod\.PL|\.yml)) # useful ending |
e275ec0e NC |
20 | (?:\s|$) # whitespace or end of line |
21 | >x) { | |
22 | push @ext, $1; | |
23 | } elsif (m!^lib/([^ \t\n]+)/[^/ \t\n]+!) { | |
24 | # All we are interested in are shipped directories in lib/ | |
25 | # leafnames (and package names) are actually irrelevant. | |
26 | my $dirs = $1; | |
27 | do { | |
28 | # lib/Pod/t is in MANIFEST, but lib/Pod is not. Rather than | |
29 | # special-casing this, generalise the code to ensure that all | |
30 | # parent directories of anything add are also added: | |
31 | ++$libdirs{$dirs} | |
32 | } while ($dirs =~ s!/.*!!); | |
33 | } | |
34 | } | |
35 | ||
36 | close $fh | |
37 | or die "Can't close MANIFEST: $!"; | |
38 | ||
39 | # Lines we need in lib/.gitignore | |
40 | my %ignore; | |
727d4ce6 NC |
41 | # Directories that the Makfiles should remove |
42 | # With a special case already :-( | |
7afc9753 | 43 | my %rmdir_s = my %rmdir = ('Unicode/Collate/Locale' => 1); |
e275ec0e NC |
44 | |
45 | FILE: | |
46 | foreach my $file (@ext) { | |
47 | my ($extname, $path) = $file =~ m!^(?:cpan|dist|ext)/([^/]+)/(.*)! | |
48 | or die "Can't parse '$file'"; | |
49 | ||
727d4ce6 NC |
50 | if ($path =~ /\.yml$/) { |
51 | next unless $path =~ s!^lib/!!; | |
52 | } elsif ($path =~ /\.pod$/) { | |
e275ec0e NC |
53 | unless ($path =~ s!^lib/!!) { |
54 | # ExtUtils::MakeMaker will install it to a path based on the | |
55 | # extension name: | |
56 | if ($extname =~ s!-[^-]+$!!) { | |
57 | $extname =~ tr!-!/!; | |
58 | $path = "$extname/$path"; | |
59 | } | |
60 | } | |
61 | } elsif ($extname eq 'Unicode-Collate' # Trust the package lines | |
62 | || $extname eq 'Encode' # Trust the package lines | |
63 | || $path eq 'win32/Win32.pm' # Trust the package line | |
64 | || ($path !~ tr!/!! # No path | |
65 | && $path ne 'DB_File.pm' # ... but has multiple package lines | |
66 | )) { | |
67 | # Too many special cases to encode, so just open the file and figure it | |
68 | # out: | |
69 | my $package; | |
70 | open my $fh, '<', $file | |
71 | or die "Can't open $file: $!"; | |
72 | while (<$fh>) { | |
73 | if (/^\s*package\s+([A-Za-z0-9_:]+)/) { | |
74 | $package = $1; | |
75 | last; | |
76 | } | |
77 | } | |
78 | close $fh | |
79 | or die "Can't close $file: $!"; | |
80 | die "Can't locate package statement in $file" | |
81 | unless defined $package; | |
82 | $package =~ s!::!/!g; | |
83 | $path = "$package.pm"; | |
84 | } else { | |
85 | if ($path =~ s/\.PL$//) { | |
86 | # .PL files generate other files. By convention the output filename | |
87 | # has the .PL stripped, and any preceding _ changed to ., to comply | |
88 | # with historical VMS filename rules that only permit one . | |
89 | $path =~ s!_([^_/]+)$!.$1!; | |
90 | } | |
91 | $path =~ s!^lib/!!; | |
92 | } | |
93 | my @parts = split '/', $path; | |
94 | my $prefix = shift @parts; | |
95 | while (@parts) { | |
96 | if (!$libdirs{$prefix}) { | |
97 | # It is a directory that we will create. Ignore everything in it: | |
98 | ++$ignore{"/$prefix/"}; | |
7afc9753 NC |
99 | ++$rmdir{$prefix}; |
100 | ++$rmdir_s{$prefix}; | |
727d4ce6 NC |
101 | pop @parts; |
102 | while (@parts) { | |
103 | $prefix .= '/' . shift @parts; | |
7afc9753 | 104 | ++$rmdir{$prefix}; |
727d4ce6 | 105 | } |
e275ec0e NC |
106 | next FILE; |
107 | } | |
108 | $prefix .= '/' . shift @parts; | |
109 | # If we've just shifted the leafname back onto $prefix, then @parts is | |
110 | # empty, so we should terminate this loop. | |
111 | } | |
112 | # We are creating a file in an existing directory. We must ignore the file | |
113 | # explicitly: | |
114 | ++$ignore{"/$path"}; | |
115 | } | |
116 | ||
727d4ce6 NC |
117 | sub edit_makefile_SH { |
118 | my ($desc, $contents) = @_; | |
119 | my $start_re = qr/(\trm -f so_locations[^\n]+)/; | |
120 | my ($start) = $contents =~ $start_re; | |
121 | $contents = verify_contiguous($desc, $contents, | |
122 | qr/$start_re\n(?:\t-rmdir [^\n]+\n)+/sm, | |
123 | 'lib directory rmdir rules'); | |
124 | # Reverse sort ensures that any subdirectories are deleted first. | |
7afc9753 NC |
125 | # The extensions themselves delete files with the MakeMaker generated clean |
126 | # targets. | |
727d4ce6 NC |
127 | $contents =~ s{\0} |
128 | {"$start\n" | |
7afc9753 NC |
129 | . wrap(79, "\t-rmdir ", "\t-rmdir ", |
130 | map {"lib/$_"} reverse sort keys %rmdir) | |
727d4ce6 NC |
131 | . "\n"}e; |
132 | $contents; | |
133 | } | |
134 | ||
7afc9753 NC |
135 | sub edit_win32_makefile { |
136 | my ($desc, $contents) = @_; | |
137 | my $start = "\t-del /f *.def *.map"; | |
138 | my $start_re = quotemeta($start); | |
139 | $contents = verify_contiguous($desc, $contents, | |
140 | qr!$start_re\n(?:\t-if exist (\$\(LIBDIR\)\\\S+) rmdir /s /q \1\n)+!sm, | |
141 | 'Win32 lib directory rmdir rules'); | |
142 | # Win32 is (currently) using rmdir /s /q which deletes recursively | |
143 | # (seems to be analogous to rm -r) so we don't explicitly list | |
144 | # subdirectories to delete, and don't need to ensure that subdirectories are | |
145 | # deleted before their parents. | |
146 | # Might be able to rely on MakeMaker generated clean targets to clean | |
147 | # everything, but not in a position to test this. | |
148 | my $lines = join '', map { | |
149 | tr!/!\\!; | |
150 | "\t-if exist \$(LIBDIR)\\$_ rmdir /s /q \$(LIBDIR)\\$_\n" | |
151 | } sort {lc $a cmp lc $b} keys %rmdir_s; | |
152 | $contents =~ s/\0/$start\n$lines/; | |
153 | $contents; | |
154 | } | |
155 | ||
727d4ce6 | 156 | process('Makefile.SH', 'Makefile.SH', \&edit_makefile_SH, $TAP && '', $Verbose); |
908f2cb5 | 157 | foreach ('win32/Makefile', 'win32/makefile.mk', 'win32/GNUmakefile') { |
7afc9753 NC |
158 | process($_, $_, \&edit_win32_makefile, $TAP && '', $Verbose); |
159 | } | |
727d4ce6 NC |
160 | |
161 | # This must come last as it can exit early: | |
e275ec0e NC |
162 | if ($TAP && !-d '.git' && !-f 'lib/.gitignore') { |
163 | print "ok # skip not being run from a git checkout, hence no lib/.gitignore\n"; | |
164 | exit 0; | |
165 | } | |
166 | ||
ba673321 DH |
167 | if ($ENV{'PERL_BUILD_PACKAGING'}) { |
168 | print "ok # skip explicitly disabled git tests by PERL_BUILD_PACKAGING\n"; | |
169 | exit 0; | |
170 | } | |
171 | ||
e275ec0e NC |
172 | $fh = open_new('lib/.gitignore', '>', |
173 | { by => $0, | |
174 | from => 'MANIFEST and parsing files in cpan/ dist/ and ext/'}); | |
175 | ||
176 | print $fh <<"EOT"; | |
177 | # If this generated file has problems, it may be simpler to add more special | |
178 | # cases to the top level .gitignore than to code one-off logic into the | |
179 | # generation script $0 | |
180 | ||
181 | EOT | |
182 | ||
183 | print $fh "$_\n" foreach sort keys %ignore; | |
184 | ||
185 | read_only_bottom_close_and_rename($fh); |