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