Commit | Line | Data |
---|---|---|
005c1a0e AD |
1 | package ExtUtils::Manifest; |
2 | ||
005c1a0e | 3 | require Exporter; |
8e07c86e | 4 | use Config; |
5dca256e | 5 | use File::Basename; |
79dd614e | 6 | use File::Copy 'copy'; |
5dca256e | 7 | use File::Find; |
57b1a898 | 8 | use File::Spec; |
005c1a0e | 9 | use Carp; |
8a1da95f | 10 | use strict; |
7f7b3776 | 11 | use warnings; |
8a1da95f | 12 | |
a6f8bc47 KE |
13 | use Exporter 5.57 'import'; |
14 | ||
7f1e728c | 15 | our $VERSION = '1.64'; |
7f7b3776 | 16 | our @EXPORT_OK = qw(mkmanifest |
479d2113 MS |
17 | manicheck filecheck fullcheck skipcheck |
18 | manifind maniread manicopy maniadd | |
6dbcfe36 | 19 | maniskip |
479d2113 | 20 | ); |
005c1a0e | 21 | |
7f7b3776 KE |
22 | our $Is_MacOS = $^O eq 'MacOS'; |
23 | our $Is_VMS = $^O eq 'VMS'; | |
24 | our $Is_VMS_mode = 0; | |
25 | our $Is_VMS_lc = 0; | |
26 | our $Is_VMS_nodot = 0; # No dots in dir names or double dots in files | |
7e4d7138 SH |
27 | |
28 | if ($Is_VMS) { | |
29 | require VMS::Filespec if $Is_VMS; | |
30 | my $vms_unix_rpt; | |
31 | my $vms_efs; | |
32 | my $vms_case; | |
33 | ||
34 | $Is_VMS_mode = 1; | |
35 | $Is_VMS_lc = 1; | |
36 | $Is_VMS_nodot = 1; | |
37 | if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { | |
38 | $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); | |
39 | $vms_efs = VMS::Feature::current("efs_charset"); | |
40 | $vms_case = VMS::Feature::current("efs_case_preserve"); | |
41 | } else { | |
42 | my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; | |
43 | my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; | |
44 | my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; | |
04721f73 | 45 | $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; |
7e4d7138 SH |
46 | $vms_efs = $efs_charset =~ /^[ET1]/i; |
47 | $vms_case = $efs_case =~ /^[ET1]/i; | |
48 | } | |
49 | $Is_VMS_lc = 0 if ($vms_case); | |
50 | $Is_VMS_mode = 0 if ($vms_unix_rpt); | |
51 | $Is_VMS_nodot = 0 if ($vms_efs); | |
52 | } | |
005c1a0e | 53 | |
7f7b3776 KE |
54 | our $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0; |
55 | our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? | |
75e2e551 | 56 | $ENV{PERL_MM_MANIFEST_VERBOSE} : 1; |
7f7b3776 KE |
57 | our $Quiet = 0; |
58 | our $MANIFEST = 'MANIFEST'; | |
479d2113 | 59 | |
7f7b3776 | 60 | our $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" ); |
4e68a208 | 61 | |
479d2113 MS |
62 | |
63 | =head1 NAME | |
64 | ||
65 | ExtUtils::Manifest - utilities to write and check a MANIFEST file | |
66 | ||
67 | =head1 SYNOPSIS | |
68 | ||
69 | use ExtUtils::Manifest qw(...funcs to import...); | |
70 | ||
71 | mkmanifest(); | |
72 | ||
73 | my @missing_files = manicheck; | |
74 | my @skipped = skipcheck; | |
75 | my @extra_files = filecheck; | |
76 | my($missing, $extra) = fullcheck; | |
77 | ||
78 | my $found = manifind(); | |
79 | ||
80 | my $manifest = maniread(); | |
81 | ||
82 | manicopy($read,$target); | |
83 | ||
84 | maniadd({$file => $comment, ...}); | |
85 | ||
86 | ||
87 | =head1 DESCRIPTION | |
88 | ||
89 | =head2 Functions | |
90 | ||
91 | ExtUtils::Manifest exports no functions by default. The following are | |
92 | exported on request | |
93 | ||
94 | =over 4 | |
95 | ||
96 | =item mkmanifest | |
97 | ||
98 | mkmanifest(); | |
99 | ||
100 | Writes all files in and below the current directory to your F<MANIFEST>. | |
6dbcfe36 | 101 | It works similar to the result of the Unix command |
479d2113 MS |
102 | |
103 | find . > MANIFEST | |
104 | ||
105 | All files that match any regular expression in a file F<MANIFEST.SKIP> | |
106 | (if it exists) are ignored. | |
107 | ||
6dbcfe36 | 108 | Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>. |
479d2113 MS |
109 | |
110 | =cut | |
111 | ||
dedf98bc MS |
112 | sub _sort { |
113 | return sort { lc $a cmp lc $b } @_; | |
114 | } | |
115 | ||
005c1a0e AD |
116 | sub mkmanifest { |
117 | my $manimiss = 0; | |
0300da75 | 118 | my $read = (-r 'MANIFEST' && maniread()) or $manimiss++; |
005c1a0e | 119 | $read = {} if $manimiss; |
864a5fa8 | 120 | local *M; |
a2fa79ff | 121 | my $bakbase = $MANIFEST; |
7e4d7138 | 122 | $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots |
a2fa79ff | 123 | rename $MANIFEST, "$bakbase.bak" unless $manimiss; |
6dbcfe36 SP |
124 | open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!"; |
125 | my $skip = maniskip(); | |
005c1a0e AD |
126 | my $found = manifind(); |
127 | my($key,$val,$file,%all); | |
f1387719 | 128 | %all = (%$found, %$read); |
7e4d7138 SH |
129 | $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') . |
130 | 'This list of files' | |
84876ac5 | 131 | if $manimiss; # add new MANIFEST to known file list |
dedf98bc | 132 | foreach $file (_sort keys %all) { |
f6d6199c MS |
133 | if ($skip->($file)) { |
134 | # Policy: only remove files if they're listed in MANIFEST.SKIP. | |
135 | # Don't remove files just because they don't exist. | |
136 | warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file}; | |
137 | next; | |
138 | } | |
005c1a0e | 139 | if ($Verbose){ |
cb1a09d0 | 140 | warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; |
005c1a0e | 141 | } |
8e07c86e | 142 | my $text = $all{$file}; |
db5fd395 | 143 | $file = _unmacify($file); |
005c1a0e AD |
144 | my $tabs = (5 - (length($file)+1)/8); |
145 | $tabs = 1 if $tabs < 1; | |
8e07c86e | 146 | $tabs = 0 unless $text; |
6dbcfe36 SP |
147 | if ($file =~ /\s/) { |
148 | $file =~ s/([\\'])/\\$1/g; | |
149 | $file = "'$file'"; | |
150 | } | |
8e07c86e | 151 | print M $file, "\t" x $tabs, $text, "\n"; |
005c1a0e AD |
152 | } |
153 | close M; | |
154 | } | |
155 | ||
04721f73 | 156 | # Geez, shouldn't this use File::Spec or File::Basename or something? |
f6d6199c MS |
157 | # Why so careful about dependencies? |
158 | sub clean_up_filename { | |
159 | my $filename = shift; | |
160 | $filename =~ s|^\./||; | |
161 | $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS; | |
8a753a87 CB |
162 | if ( $Is_VMS ) { |
163 | $filename =~ s/\.$//; # trim trailing dot | |
164 | $filename = VMS::Filespec::unixify($filename); # unescape spaces, etc. | |
165 | if( $Is_VMS_lc ) { | |
166 | $filename = lc($filename); | |
167 | $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i; | |
168 | } | |
169 | } | |
f6d6199c MS |
170 | return $filename; |
171 | } | |
172 | ||
479d2113 MS |
173 | |
174 | =item manifind | |
175 | ||
176 | my $found = manifind(); | |
177 | ||
178 | returns a hash reference. The keys of the hash are the files found | |
179 | below the current directory. | |
180 | ||
181 | =cut | |
182 | ||
005c1a0e | 183 | sub manifind { |
f6d6199c | 184 | my $p = shift || {}; |
f6d6199c MS |
185 | my $found = {}; |
186 | ||
187 | my $wanted = sub { | |
188 | my $name = clean_up_filename($File::Find::name); | |
189 | warn "Debug: diskfile $name\n" if $Debug; | |
57b1a898 | 190 | return if -d $_; |
f6d6199c MS |
191 | $found->{$name} = ""; |
192 | }; | |
193 | ||
04721f73 | 194 | # We have to use "$File::Find::dir/$_" in preprocess, because |
f6d6199c | 195 | # $File::Find::name is unavailable. |
04721f73 | 196 | # Also, it's okay to use / here, because MANIFEST files use Unix-style |
f6d6199c | 197 | # paths. |
57b1a898 | 198 | find({wanted => $wanted}, |
f6d6199c MS |
199 | $Is_MacOS ? ":" : "."); |
200 | ||
201 | return $found; | |
005c1a0e AD |
202 | } |
203 | ||
479d2113 MS |
204 | |
205 | =item manicheck | |
206 | ||
207 | my @missing_files = manicheck(); | |
208 | ||
209 | checks if all the files within a C<MANIFEST> in the current directory | |
210 | really do exist. If C<MANIFEST> and the tree below the current | |
2c91f887 | 211 | directory are in sync it silently returns an empty list. |
479d2113 MS |
212 | Otherwise it returns a list of files which are listed in the |
213 | C<MANIFEST> but missing from the directory, and by default also | |
214 | outputs these names to STDERR. | |
215 | ||
216 | =cut | |
005c1a0e AD |
217 | |
218 | sub manicheck { | |
45bc4d3a | 219 | return _check_files(); |
005c1a0e AD |
220 | } |
221 | ||
479d2113 MS |
222 | |
223 | =item filecheck | |
224 | ||
225 | my @extra_files = filecheck(); | |
226 | ||
227 | finds files below the current directory that are not mentioned in the | |
228 | C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be | |
229 | consulted. Any file matching a regular expression in such a file will | |
230 | not be reported as missing in the C<MANIFEST> file. The list of any | |
231 | extraneous files found is returned, and by default also reported to | |
232 | STDERR. | |
233 | ||
234 | =cut | |
235 | ||
005c1a0e | 236 | sub filecheck { |
45bc4d3a | 237 | return _check_manifest(); |
005c1a0e AD |
238 | } |
239 | ||
479d2113 MS |
240 | |
241 | =item fullcheck | |
242 | ||
243 | my($missing, $extra) = fullcheck(); | |
244 | ||
245 | does both a manicheck() and a filecheck(), returning then as two array | |
246 | refs. | |
247 | ||
248 | =cut | |
249 | ||
250 | sub fullcheck { | |
251 | return [_check_files()], [_check_manifest()]; | |
252 | } | |
253 | ||
254 | ||
255 | =item skipcheck | |
256 | ||
257 | my @skipped = skipcheck(); | |
258 | ||
259 | lists all the files that are skipped due to your C<MANIFEST.SKIP> | |
260 | file. | |
261 | ||
262 | =cut | |
263 | ||
8e07c86e | 264 | sub skipcheck { |
45bc4d3a JH |
265 | my($p) = @_; |
266 | my $found = manifind(); | |
6dbcfe36 | 267 | my $matches = maniskip(); |
45bc4d3a JH |
268 | |
269 | my @skipped = (); | |
dedf98bc | 270 | foreach my $file (_sort keys %$found){ |
45bc4d3a | 271 | if (&$matches($file)){ |
551c793c | 272 | warn "Skipping $file\n" unless $Quiet; |
45bc4d3a JH |
273 | push @skipped, $file; |
274 | next; | |
275 | } | |
276 | } | |
277 | ||
278 | return @skipped; | |
8e07c86e AD |
279 | } |
280 | ||
f6d6199c | 281 | |
45bc4d3a JH |
282 | sub _check_files { |
283 | my $p = shift; | |
39e571d4 | 284 | my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); |
45bc4d3a JH |
285 | my $read = maniread() || {}; |
286 | my $found = manifind($p); | |
287 | ||
288 | my(@missfile) = (); | |
dedf98bc | 289 | foreach my $file (_sort keys %$read){ |
45bc4d3a JH |
290 | warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; |
291 | if ($dosnames){ | |
292 | $file = lc $file; | |
293 | $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; | |
294 | $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; | |
295 | } | |
296 | unless ( exists $found->{$file} ) { | |
297 | warn "No such file: $file\n" unless $Quiet; | |
298 | push @missfile, $file; | |
299 | } | |
005c1a0e | 300 | } |
45bc4d3a JH |
301 | |
302 | return @missfile; | |
303 | } | |
304 | ||
305 | ||
306 | sub _check_manifest { | |
307 | my($p) = @_; | |
308 | my $read = maniread() || {}; | |
309 | my $found = manifind($p); | |
6dbcfe36 | 310 | my $skip = maniskip(); |
45bc4d3a JH |
311 | |
312 | my @missentry = (); | |
dedf98bc | 313 | foreach my $file (_sort keys %$found){ |
45bc4d3a JH |
314 | next if $skip->($file); |
315 | warn "Debug: manicheck checking from disk $file\n" if $Debug; | |
316 | unless ( exists $read->{$file} ) { | |
317 | my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; | |
318 | warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; | |
319 | push @missentry, $file; | |
320 | } | |
005c1a0e | 321 | } |
45bc4d3a JH |
322 | |
323 | return @missentry; | |
005c1a0e AD |
324 | } |
325 | ||
45bc4d3a | 326 | |
479d2113 MS |
327 | =item maniread |
328 | ||
329 | my $manifest = maniread(); | |
330 | my $manifest = maniread($manifest_file); | |
331 | ||
332 | reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current | |
333 | directory) and returns a HASH reference with files being the keys and | |
334 | comments being the values of the HASH. Blank lines and lines which | |
335 | start with C<#> in the C<MANIFEST> file are discarded. | |
336 | ||
337 | =cut | |
338 | ||
005c1a0e AD |
339 | sub maniread { |
340 | my ($mfile) = @_; | |
15a074ca | 341 | $mfile ||= $MANIFEST; |
005c1a0e AD |
342 | my $read = {}; |
343 | local *M; | |
6dbcfe36 | 344 | unless (open M, "< $mfile"){ |
1c14aae0 | 345 | warn "Problem opening $mfile: $!"; |
2530b651 | 346 | return $read; |
005c1a0e | 347 | } |
2530b651 | 348 | local $_; |
005c1a0e | 349 | while (<M>){ |
2530b651 | 350 | chomp; |
1df8d179 | 351 | next if /^\s*#/; |
0e3309e2 | 352 | |
6dbcfe36 SP |
353 | my($file, $comment); |
354 | ||
355 | # filename may contain spaces if enclosed in '' | |
356 | # (in which case, \\ and \' are escapes) | |
357 | if (($file, $comment) = /^'(\\[\\']|.+)+'\s*(.*)/) { | |
358 | $file =~ s/\\([\\'])/$1/g; | |
359 | } | |
360 | else { | |
361 | ($file, $comment) = /^(\S+)\s*(.*)/; | |
362 | } | |
0e3309e2 MS |
363 | next unless $file; |
364 | ||
2530b651 MS |
365 | if ($Is_MacOS) { |
366 | $file = _macify($file); | |
367 | $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge; | |
368 | } | |
7e4d7138 | 369 | elsif ($Is_VMS_mode) { |
2530b651 MS |
370 | require File::Basename; |
371 | my($base,$dir) = File::Basename::fileparse($file); | |
372 | # Resolve illegal file specifications in the same way as tar | |
7e4d7138 SH |
373 | if ($Is_VMS_nodot) { |
374 | $dir =~ tr/./_/; | |
375 | my(@pieces) = split(/\./,$base); | |
376 | if (@pieces > 2) | |
377 | { $base = shift(@pieces) . '.' . join('_',@pieces); } | |
378 | my $okfile = "$dir$base"; | |
379 | warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; | |
380 | $file = $okfile; | |
04721f73 | 381 | } |
6d1b7e1c CB |
382 | if( $Is_VMS_lc ) { |
383 | $file = lc($file); | |
384 | $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i; | |
385 | } | |
2530b651 | 386 | } |
0e3309e2 MS |
387 | |
388 | $read->{$file} = $comment; | |
005c1a0e AD |
389 | } |
390 | close M; | |
391 | $read; | |
392 | } | |
393 | ||
6dbcfe36 SP |
394 | =item maniskip |
395 | ||
396 | my $skipchk = maniskip(); | |
397 | my $skipchk = maniskip($manifest_skip_file); | |
398 | ||
399 | if ($skipchk->($file)) { .. } | |
400 | ||
401 | reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in | |
402 | the current directory) and returns a CODE reference that tests whether | |
403 | a given filename should be skipped. | |
404 | ||
405 | =cut | |
406 | ||
005c1a0e | 407 | # returns an anonymous sub that decides if an argument matches |
6dbcfe36 | 408 | sub maniskip { |
005c1a0e | 409 | my @skip ; |
6dbcfe36 | 410 | my $mfile = shift || "$MANIFEST.SKIP"; |
1c14aae0 RGS |
411 | _check_mskip_directives($mfile) if -f $mfile; |
412 | local(*M, $_); | |
6dbcfe36 | 413 | open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0}; |
005c1a0e | 414 | while (<M>){ |
551c793c SH |
415 | chomp; |
416 | s/\r//; | |
417 | $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$}; | |
418 | #my $comment = $3; | |
419 | my $filename = $2; | |
04721f73 FR |
420 | if ( defined($1) ) { |
421 | $filename = $1; | |
551c793c SH |
422 | $filename =~ s/\\(['\\])/$1/g; |
423 | } | |
424 | next if (not defined($filename) or not $filename); | |
425 | push @skip, _macify($filename); | |
005c1a0e AD |
426 | } |
427 | close M; | |
b3217f3b SP |
428 | return sub {0} unless (scalar @skip > 0); |
429 | ||
7e4d7138 | 430 | my $opts = $Is_VMS_mode ? '(?i)' : ''; |
f6d6199c MS |
431 | |
432 | # Make sure each entry is isolated in its own parentheses, in case | |
433 | # any of them contain alternations | |
434 | my $regex = join '|', map "(?:$_)", @skip; | |
435 | ||
45bc4d3a | 436 | return sub { $_[0] =~ qr{$opts$regex} }; |
005c1a0e AD |
437 | } |
438 | ||
1c14aae0 RGS |
439 | # checks for the special directives |
440 | # #!include_default | |
441 | # #!include /path/to/some/manifest.skip | |
442 | # in a custom MANIFEST.SKIP for, for including | |
443 | # the content of, respectively, the default MANIFEST.SKIP | |
444 | # and an external manifest.skip file | |
445 | sub _check_mskip_directives { | |
446 | my $mfile = shift; | |
447 | local (*M, $_); | |
448 | my @lines = (); | |
449 | my $flag = 0; | |
6dbcfe36 | 450 | unless (open M, "< $mfile") { |
1c14aae0 RGS |
451 | warn "Problem opening $mfile: $!"; |
452 | return; | |
453 | } | |
454 | while (<M>) { | |
455 | if (/^#!include_default\s*$/) { | |
456 | if (my @default = _include_mskip_file()) { | |
457 | push @lines, @default; | |
458 | warn "Debug: Including default MANIFEST.SKIP\n" if $Debug; | |
459 | $flag++; | |
460 | } | |
461 | next; | |
462 | } | |
463 | if (/^#!include\s+(.*)\s*$/) { | |
464 | my $external_file = $1; | |
465 | if (my @external = _include_mskip_file($external_file)) { | |
466 | push @lines, @external; | |
467 | warn "Debug: Including external $external_file\n" if $Debug; | |
468 | $flag++; | |
469 | } | |
470 | next; | |
471 | } | |
472 | push @lines, $_; | |
473 | } | |
474 | close M; | |
475 | return unless $flag; | |
a2fa79ff | 476 | my $bakbase = $mfile; |
7e4d7138 | 477 | $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots |
a2fa79ff CB |
478 | rename $mfile, "$bakbase.bak"; |
479 | warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug; | |
6dbcfe36 | 480 | unless (open M, "> $mfile") { |
1c14aae0 RGS |
481 | warn "Problem opening $mfile: $!"; |
482 | return; | |
483 | } | |
484 | print M $_ for (@lines); | |
485 | close M; | |
486 | return; | |
487 | } | |
488 | ||
489 | # returns an array containing the lines of an external | |
490 | # manifest.skip file, if given, or $DEFAULT_MSKIP | |
491 | sub _include_mskip_file { | |
492 | my $mskip = shift || $DEFAULT_MSKIP; | |
493 | unless (-f $mskip) { | |
494 | warn qq{Included file "$mskip" not found - skipping}; | |
495 | return; | |
496 | } | |
497 | local (*M, $_); | |
6dbcfe36 | 498 | unless (open M, "< $mskip") { |
1c14aae0 RGS |
499 | warn "Problem opening $mskip: $!"; |
500 | return; | |
501 | } | |
502 | my @lines = (); | |
503 | push @lines, "\n#!start included $mskip\n"; | |
504 | push @lines, $_ while <M>; | |
505 | close M; | |
506 | push @lines, "#!end included $mskip\n\n"; | |
507 | return @lines; | |
508 | } | |
509 | ||
479d2113 MS |
510 | =item manicopy |
511 | ||
a7d1454b RGS |
512 | manicopy(\%src, $dest_dir); |
513 | manicopy(\%src, $dest_dir, $how); | |
479d2113 | 514 | |
a7d1454b RGS |
515 | Copies the files that are the keys in %src to the $dest_dir. %src is |
516 | typically returned by the maniread() function. | |
517 | ||
518 | manicopy( maniread(), $dest_dir ); | |
519 | ||
04721f73 FR |
520 | This function is useful for producing a directory tree identical to the |
521 | intended distribution tree. | |
a7d1454b RGS |
522 | |
523 | $how can be used to specify a different methods of "copying". Valid | |
479d2113 MS |
524 | values are C<cp>, which actually copies the files, C<ln> which creates |
525 | hard links, and C<best> which mostly links the files but copies any | |
04721f73 | 526 | symbolic link to make a tree without any symbolic link. C<cp> is the |
479d2113 MS |
527 | default. |
528 | ||
529 | =cut | |
530 | ||
005c1a0e | 531 | sub manicopy { |
8e07c86e | 532 | my($read,$target,$how)=@_; |
005c1a0e | 533 | croak "manicopy() called without target argument" unless defined $target; |
15a074ca | 534 | $how ||= 'cp'; |
005c1a0e AD |
535 | require File::Path; |
536 | require File::Basename; | |
57b1a898 | 537 | |
7e4d7138 | 538 | $target = VMS::Filespec::unixify($target) if $Is_VMS_mode; |
553c0e07 | 539 | File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); |
57b1a898 | 540 | foreach my $file (keys %$read){ |
04721f73 FR |
541 | if ($Is_MacOS) { |
542 | if ($file =~ m!:!) { | |
543 | my $dir = _maccat($target, $file); | |
db5fd395 | 544 | $dir =~ s/[^:]+$//; |
04721f73 | 545 | File::Path::mkpath($dir,1,0755); |
db5fd395 CN |
546 | } |
547 | cp_if_diff($file, _maccat($target, $file), $how); | |
548 | } else { | |
7e4d7138 | 549 | $file = VMS::Filespec::unixify($file) if $Is_VMS_mode; |
db5fd395 CN |
550 | if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? |
551 | my $dir = File::Basename::dirname($file); | |
7e4d7138 | 552 | $dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode; |
db5fd395 CN |
553 | File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755); |
554 | } | |
555 | cp_if_diff($file, "$target/$file", $how); | |
84876ac5 | 556 | } |
005c1a0e AD |
557 | } |
558 | } | |
559 | ||
560 | sub cp_if_diff { | |
8a1da95f | 561 | my($from, $to, $how)=@_; |
6dbcfe36 SP |
562 | if (! -f $from) { |
563 | carp "$from not found"; | |
564 | return; | |
565 | } | |
8e07c86e AD |
566 | my($diff) = 0; |
567 | local(*F,*T); | |
57b1a898 | 568 | open(F,"< $from\0") or die "Can't read $from: $!\n"; |
db5fd395 | 569 | if (open(T,"< $to\0")) { |
2530b651 | 570 | local $_; |
8e07c86e AD |
571 | while (<F>) { $diff++,last if $_ ne <T>; } |
572 | $diff++ unless eof(T); | |
573 | close T; | |
574 | } | |
575 | else { $diff++; } | |
576 | close F; | |
577 | if ($diff) { | |
578 | if (-e $to) { | |
579 | unlink($to) or confess "unlink $to: $!"; | |
580 | } | |
7292dc67 | 581 | STRICT_SWITCH: { |
15a074ca AK |
582 | best($from,$to), last STRICT_SWITCH if $how eq 'best'; |
583 | cp($from,$to), last STRICT_SWITCH if $how eq 'cp'; | |
584 | ln($from,$to), last STRICT_SWITCH if $how eq 'ln'; | |
585 | croak("ExtUtils::Manifest::cp_if_diff " . | |
586 | "called with illegal how argument [$how]. " . | |
587 | "Legal values are 'best', 'cp', and 'ln'."); | |
588 | } | |
8e07c86e AD |
589 | } |
590 | } | |
591 | ||
8e07c86e AD |
592 | sub cp { |
593 | my ($srcFile, $dstFile) = @_; | |
a7d1454b RGS |
594 | my ($access,$mod) = (stat $srcFile)[8,9]; |
595 | ||
79dd614e | 596 | copy($srcFile,$dstFile); |
9607fc9c | 597 | utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; |
1c14aae0 | 598 | _manicopy_chmod($srcFile, $dstFile); |
8e07c86e AD |
599 | } |
600 | ||
a7d1454b | 601 | |
8e07c86e AD |
602 | sub ln { |
603 | my ($srcFile, $dstFile) = @_; | |
7e4d7138 | 604 | # Fix-me - VMS can support links. |
f0f13d0e | 605 | return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); |
8e07c86e | 606 | link($srcFile, $dstFile); |
57b1a898 | 607 | |
1c14aae0 | 608 | unless( _manicopy_chmod($srcFile, $dstFile) ) { |
57b1a898 MS |
609 | unlink $dstFile; |
610 | return; | |
4e6ea2c3 GS |
611 | } |
612 | 1; | |
8e07c86e AD |
613 | } |
614 | ||
a7d1454b RGS |
615 | # 1) Strip off all group and world permissions. |
616 | # 2) Let everyone read it. | |
617 | # 3) If the owner can execute it, everyone can. | |
618 | sub _manicopy_chmod { | |
1c14aae0 | 619 | my($srcFile, $dstFile) = @_; |
57b1a898 | 620 | |
1c14aae0 RGS |
621 | my $perm = 0444 | (stat $srcFile)[2] & 0700; |
622 | chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile ); | |
a7d1454b | 623 | } |
57b1a898 | 624 | |
7292dc67 RGS |
625 | # Files that are often modified in the distdir. Don't hard link them. |
626 | my @Exceptions = qw(MANIFEST META.yml SIGNATURE); | |
4633a7c4 LW |
627 | sub best { |
628 | my ($srcFile, $dstFile) = @_; | |
7292dc67 RGS |
629 | |
630 | my $is_exception = grep $srcFile =~ /$_/, @Exceptions; | |
631 | if ($is_exception or !$Config{d_link} or -l $srcFile) { | |
4633a7c4 LW |
632 | cp($srcFile, $dstFile); |
633 | } else { | |
3dee4013 | 634 | ln($srcFile, $dstFile) or cp($srcFile, $dstFile); |
4633a7c4 LW |
635 | } |
636 | } | |
637 | ||
db5fd395 CN |
638 | sub _macify { |
639 | my($file) = @_; | |
640 | ||
641 | return $file unless $Is_MacOS; | |
a7d1454b | 642 | |
db5fd395 CN |
643 | $file =~ s|^\./||; |
644 | if ($file =~ m|/|) { | |
645 | $file =~ s|/+|:|g; | |
646 | $file = ":$file"; | |
647 | } | |
a7d1454b | 648 | |
db5fd395 CN |
649 | $file; |
650 | } | |
651 | ||
652 | sub _maccat { | |
653 | my($f1, $f2) = @_; | |
a7d1454b | 654 | |
db5fd395 | 655 | return "$f1/$f2" unless $Is_MacOS; |
a7d1454b | 656 | |
db5fd395 CN |
657 | $f1 .= ":$f2"; |
658 | $f1 =~ s/([^:]:):/$1/g; | |
659 | return $f1; | |
660 | } | |
661 | ||
662 | sub _unmacify { | |
663 | my($file) = @_; | |
664 | ||
665 | return $file unless $Is_MacOS; | |
5dca256e | 666 | |
db5fd395 CN |
667 | $file =~ s|^:||; |
668 | $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge; | |
669 | $file =~ y|:|/|; | |
5dca256e | 670 | |
db5fd395 CN |
671 | $file; |
672 | } | |
673 | ||
79dd614e | 674 | |
479d2113 | 675 | =item maniadd |
79dd614e | 676 | |
479d2113 | 677 | maniadd({ $file => $comment, ...}); |
79dd614e | 678 | |
1df8d179 | 679 | Adds an entry to an existing F<MANIFEST> unless its already there. |
79dd614e | 680 | |
479d2113 | 681 | $file will be normalized (ie. Unixified). B<UNIMPLEMENTED> |
79dd614e | 682 | |
479d2113 | 683 | =cut |
79dd614e | 684 | |
479d2113 MS |
685 | sub maniadd { |
686 | my($additions) = shift; | |
79dd614e | 687 | |
479d2113 | 688 | _normalize($additions); |
2530b651 | 689 | _fix_manifest($MANIFEST); |
79dd614e | 690 | |
479d2113 | 691 | my $manifest = maniread(); |
30361541 JH |
692 | my @needed = grep { !exists $manifest->{$_} } keys %$additions; |
693 | return 1 unless @needed; | |
1df8d179 | 694 | |
04721f73 | 695 | open(MANIFEST, ">>$MANIFEST") or |
30361541 | 696 | die "maniadd() could not open $MANIFEST: $!"; |
2c91f887 | 697 | |
30361541 | 698 | foreach my $file (_sort @needed) { |
dedf98bc | 699 | my $comment = $additions->{$file} || ''; |
6dbcfe36 SP |
700 | if ($file =~ /\s/) { |
701 | $file =~ s/([\\'])/\\$1/g; | |
702 | $file = "'$file'"; | |
703 | } | |
30361541 | 704 | printf MANIFEST "%-40s %s\n", $file, $comment; |
479d2113 | 705 | } |
30361541 JH |
706 | close MANIFEST or die "Error closing $MANIFEST: $!"; |
707 | ||
708 | return 1; | |
479d2113 | 709 | } |
79dd614e | 710 | |
2530b651 | 711 | |
e4ac890e SA |
712 | # Make sure this MANIFEST is consistently written with native |
713 | # newlines and has a terminal newline. | |
2530b651 MS |
714 | sub _fix_manifest { |
715 | my $manifest_file = shift; | |
716 | ||
717 | open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!"; | |
e4ac890e SA |
718 | local $/; |
719 | my @manifest = split /(\015\012|\012|\015)/, <MANIFEST>, -1; | |
2530b651 | 720 | close MANIFEST; |
e4ac890e SA |
721 | my $must_rewrite = ""; |
722 | if ($manifest[-1] eq ""){ | |
723 | # sane case: last line had a terminal newline | |
724 | pop @manifest; | |
725 | for (my $i=1; $i<=$#manifest; $i+=2) { | |
726 | unless ($manifest[$i] eq "\n") { | |
727 | $must_rewrite = "not a newline at pos $i"; | |
728 | last; | |
729 | } | |
730 | } | |
731 | } else { | |
732 | $must_rewrite = "last line without newline"; | |
733 | } | |
2530b651 | 734 | |
e4ac890e | 735 | if ( $must_rewrite ) { |
f4ef3693 | 736 | 1 while unlink $MANIFEST; # avoid multiple versions on VMS |
e4ac890e SA |
737 | open MANIFEST, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!"; |
738 | for (my $i=0; $i<=$#manifest; $i+=2) { | |
739 | print MANIFEST "$manifest[$i]\n"; | |
740 | } | |
741 | close MANIFEST or die "could not write $MANIFEST: $!"; | |
2530b651 MS |
742 | } |
743 | } | |
5dca256e | 744 | |
2530b651 | 745 | |
479d2113 MS |
746 | # UNIMPLEMENTED |
747 | sub _normalize { | |
748 | return; | |
749 | } | |
79dd614e | 750 | |
79dd614e | 751 | |
479d2113 | 752 | =back |
79dd614e | 753 | |
479d2113 | 754 | =head2 MANIFEST |
79dd614e | 755 | |
5dca256e RGS |
756 | A list of files in the distribution, one file per line. The MANIFEST |
757 | always uses Unix filepath conventions even if you're not on Unix. This | |
758 | means F<foo/bar> style not F<foo\bar>. | |
759 | ||
479d2113 | 760 | Anything between white space and an end of line within a C<MANIFEST> |
5dca256e | 761 | file is considered to be a comment. Any line beginning with # is also |
6dbcfe36 SP |
762 | a comment. Beginning with ExtUtils::Manifest 1.52, a filename may |
763 | contain whitespace characters if it is enclosed in single quotes; single | |
764 | quotes or backslashes in that filename must be backslash-escaped. | |
5dca256e RGS |
765 | |
766 | # this a comment | |
767 | some/file | |
768 | some/other/file comment about some/file | |
6dbcfe36 | 769 | 'some/third file' comment |
79dd614e | 770 | |
79dd614e | 771 | |
479d2113 | 772 | =head2 MANIFEST.SKIP |
79dd614e PP |
773 | |
774 | The file MANIFEST.SKIP may contain regular expressions of files that | |
775 | should be ignored by mkmanifest() and filecheck(). The regular | |
15a074ca AK |
776 | expressions should appear one on each line. Blank lines and lines |
777 | which start with C<#> are skipped. Use C<\#> if you need a regular | |
5dca256e RGS |
778 | expression to start with a C<#>. |
779 | ||
780 | For example: | |
79dd614e | 781 | |
0b9c804f | 782 | # Version control files and dirs. |
79dd614e | 783 | \bRCS\b |
0b9c804f MS |
784 | \bCVS\b |
785 | ,v$ | |
479d2113 | 786 | \B\.svn\b |
0b9c804f MS |
787 | |
788 | # Makemaker generated files and dirs. | |
79dd614e PP |
789 | ^MANIFEST\. |
790 | ^Makefile$ | |
79dd614e PP |
791 | ^blib/ |
792 | ^MakeMaker-\d | |
793 | ||
0b9c804f MS |
794 | # Temp, old and emacs backup files. |
795 | ~$ | |
796 | \.old$ | |
797 | ^#.*#$ | |
cfcce72b | 798 | ^\.# |
0b9c804f MS |
799 | |
800 | If no MANIFEST.SKIP file is found, a default set of skips will be | |
801 | used, similar to the example above. If you want nothing skipped, | |
802 | simply make an empty MANIFEST.SKIP file. | |
803 | ||
1c14aae0 RGS |
804 | In one's own MANIFEST.SKIP file, certain directives |
805 | can be used to include the contents of other MANIFEST.SKIP | |
806 | files. At present two such directives are recognized. | |
807 | ||
808 | =over 4 | |
809 | ||
810 | =item #!include_default | |
811 | ||
812 | This inserts the contents of the default MANIFEST.SKIP file | |
813 | ||
814 | =item #!include /Path/to/another/manifest.skip | |
815 | ||
816 | This inserts the contents of the specified external file | |
817 | ||
818 | =back | |
819 | ||
820 | The included contents will be inserted into the MANIFEST.SKIP | |
821 | file in between I<#!start included /path/to/manifest.skip> | |
822 | and I<#!end included /path/to/manifest.skip> markers. | |
823 | The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak. | |
0b9c804f | 824 | |
479d2113 | 825 | =head2 EXPORT_OK |
79dd614e PP |
826 | |
827 | C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>, | |
828 | C<&maniread>, and C<&manicopy> are exportable. | |
829 | ||
479d2113 | 830 | =head2 GLOBAL VARIABLES |
79dd614e PP |
831 | |
832 | C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it | |
833 | results in both a different C<MANIFEST> and a different | |
834 | C<MANIFEST.SKIP> file. This is useful if you want to maintain | |
835 | different distributions for different audiences (say a user version | |
836 | and a developer version including RCS). | |
837 | ||
81ff29e3 | 838 | C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value, |
79dd614e PP |
839 | all functions act silently. |
840 | ||
0b9c804f MS |
841 | C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value, |
842 | or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be | |
843 | produced. | |
844 | ||
79dd614e PP |
845 | =head1 DIAGNOSTICS |
846 | ||
847 | All diagnostic output is sent to C<STDERR>. | |
848 | ||
bbc7dcd2 | 849 | =over 4 |
79dd614e PP |
850 | |
851 | =item C<Not in MANIFEST:> I<file> | |
852 | ||
45bc4d3a JH |
853 | is reported if a file is found which is not in C<MANIFEST>. |
854 | ||
855 | =item C<Skipping> I<file> | |
856 | ||
857 | is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>. | |
79dd614e PP |
858 | |
859 | =item C<No such file:> I<file> | |
860 | ||
861 | is reported if a file mentioned in a C<MANIFEST> file does not | |
862 | exist. | |
863 | ||
864 | =item C<MANIFEST:> I<$!> | |
865 | ||
866 | is reported if C<MANIFEST> could not be opened. | |
867 | ||
868 | =item C<Added to MANIFEST:> I<file> | |
869 | ||
870 | is reported by mkmanifest() if $Verbose is set and a file is added | |
871 | to MANIFEST. $Verbose is set to 1 by default. | |
872 | ||
873 | =back | |
874 | ||
0b9c804f MS |
875 | =head1 ENVIRONMENT |
876 | ||
877 | =over 4 | |
878 | ||
879 | =item B<PERL_MM_MANIFEST_DEBUG> | |
880 | ||
881 | Turns on debugging | |
882 | ||
883 | =back | |
884 | ||
79dd614e PP |
885 | =head1 SEE ALSO |
886 | ||
887 | L<ExtUtils::MakeMaker> which has handy targets for most of the functionality. | |
888 | ||
889 | =head1 AUTHOR | |
890 | ||
a7d1454b RGS |
891 | Andreas Koenig C<andreas.koenig@anima.de> |
892 | ||
4c857482 SP |
893 | Maintained by Michael G Schwern C<schwern@pobox.com> within the |
894 | ExtUtils-MakeMaker package and, as a separate CPAN package, by | |
895 | Randy Kobes C<r.kobes@uwinnipeg.ca>. | |
79dd614e PP |
896 | |
897 | =cut | |
479d2113 MS |
898 | |
899 | 1; |