This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
stray n_a
[perl5.git] / lib / ExtUtils / Manifest.pm
CommitLineData
005c1a0e
AD
1package ExtUtils::Manifest;
2
005c1a0e 3require Exporter;
8e07c86e 4use Config;
005c1a0e 5use File::Find;
79dd614e 6use File::Copy 'copy';
57b1a898 7use File::Spec;
005c1a0e 8use Carp;
8a1da95f
PP
9use strict;
10
57b1a898
MS
11use vars qw($VERSION @ISA @EXPORT_OK
12 $Is_MacOS $Is_VMS
13 $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
8a1da95f 14
69ff8adf 15$VERSION = 1.38;
8a1da95f
PP
16@ISA=('Exporter');
17@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
18 'skipcheck', 'maniread', 'manicopy');
005c1a0e 19
db5fd395 20$Is_MacOS = $^O eq 'MacOS';
79dd614e 21$Is_VMS = $^O eq 'VMS';
f6d6199c 22require VMS::Filespec if $Is_VMS;
005c1a0e 23
0b9c804f 24$Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
75e2e551
MS
25$Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
26 $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
005c1a0e 27$Quiet = 0;
cb1a09d0 28$MANIFEST = 'MANIFEST';
57b1a898
MS
29$DEFAULT_MSKIP = (File::Spec->splitpath($INC{"ExtUtils/Manifest.pm"}))[1].
30 "$MANIFEST.SKIP";
4e68a208 31
005c1a0e
AD
32sub mkmanifest {
33 my $manimiss = 0;
0300da75 34 my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
005c1a0e 35 $read = {} if $manimiss;
864a5fa8 36 local *M;
cb1a09d0
AD
37 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
38 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
f6d6199c 39 my $skip = _maniskip();
005c1a0e
AD
40 my $found = manifind();
41 my($key,$val,$file,%all);
f1387719 42 %all = (%$found, %$read);
84876ac5
PP
43 $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
44 if $manimiss; # add new MANIFEST to known file list
005c1a0e 45 foreach $file (sort keys %all) {
f6d6199c
MS
46 if ($skip->($file)) {
47 # Policy: only remove files if they're listed in MANIFEST.SKIP.
48 # Don't remove files just because they don't exist.
49 warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
50 next;
51 }
005c1a0e 52 if ($Verbose){
cb1a09d0 53 warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
005c1a0e 54 }
8e07c86e 55 my $text = $all{$file};
84876ac5 56 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
db5fd395 57 $file = _unmacify($file);
005c1a0e
AD
58 my $tabs = (5 - (length($file)+1)/8);
59 $tabs = 1 if $tabs < 1;
8e07c86e
AD
60 $tabs = 0 unless $text;
61 print M $file, "\t" x $tabs, $text, "\n";
005c1a0e
AD
62 }
63 close M;
64}
65
f6d6199c
MS
66# Geez, shouldn't this use File::Spec or File::Basename or something?
67# Why so careful about dependencies?
68sub clean_up_filename {
69 my $filename = shift;
70 $filename =~ s|^\./||;
71 $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
72 return $filename;
73}
74
005c1a0e 75sub manifind {
f6d6199c 76 my $p = shift || {};
f6d6199c
MS
77 my $found = {};
78
79 my $wanted = sub {
80 my $name = clean_up_filename($File::Find::name);
81 warn "Debug: diskfile $name\n" if $Debug;
57b1a898 82 return if -d $_;
f6d6199c
MS
83
84 if( $Is_VMS ) {
85 $name =~ s#(.*)\.$#\L$1#;
86 $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
87 }
88 $found->{$name} = "";
89 };
90
91 # We have to use "$File::Find::dir/$_" in preprocess, because
92 # $File::Find::name is unavailable.
93 # Also, it's okay to use / here, because MANIFEST files use Unix-style
94 # paths.
57b1a898 95 find({wanted => $wanted},
f6d6199c
MS
96 $Is_MacOS ? ":" : ".");
97
98 return $found;
005c1a0e
AD
99}
100
101sub fullcheck {
45bc4d3a 102 return [_check_files()], [_check_manifest()];
005c1a0e
AD
103}
104
105sub manicheck {
45bc4d3a 106 return _check_files();
005c1a0e
AD
107}
108
109sub filecheck {
45bc4d3a 110 return _check_manifest();
005c1a0e
AD
111}
112
8e07c86e 113sub skipcheck {
45bc4d3a
JH
114 my($p) = @_;
115 my $found = manifind();
116 my $matches = _maniskip();
117
118 my @skipped = ();
119 foreach my $file (sort keys %$found){
120 if (&$matches($file)){
121 warn "Skipping $file\n";
122 push @skipped, $file;
123 next;
124 }
125 }
126
127 return @skipped;
8e07c86e
AD
128}
129
f6d6199c 130
45bc4d3a
JH
131sub _check_files {
132 my $p = shift;
39e571d4 133 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
45bc4d3a
JH
134 my $read = maniread() || {};
135 my $found = manifind($p);
136
137 my(@missfile) = ();
138 foreach my $file (sort keys %$read){
139 warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
140 if ($dosnames){
141 $file = lc $file;
142 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
143 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
144 }
145 unless ( exists $found->{$file} ) {
146 warn "No such file: $file\n" unless $Quiet;
147 push @missfile, $file;
148 }
005c1a0e 149 }
45bc4d3a
JH
150
151 return @missfile;
152}
153
154
155sub _check_manifest {
156 my($p) = @_;
157 my $read = maniread() || {};
158 my $found = manifind($p);
159 my $skip = _maniskip();
160
161 my @missentry = ();
162 foreach my $file (sort keys %$found){
163 next if $skip->($file);
164 warn "Debug: manicheck checking from disk $file\n" if $Debug;
165 unless ( exists $read->{$file} ) {
166 my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
167 warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
168 push @missentry, $file;
169 }
005c1a0e 170 }
45bc4d3a
JH
171
172 return @missentry;
005c1a0e
AD
173}
174
45bc4d3a 175
005c1a0e
AD
176sub maniread {
177 my ($mfile) = @_;
15a074ca 178 $mfile ||= $MANIFEST;
005c1a0e
AD
179 my $read = {};
180 local *M;
181 unless (open M, $mfile){
182 warn "$mfile: $!";
183 return $read;
184 }
185 while (<M>){
186 chomp;
15a074ca 187 next if /^#/;
0e3309e2
MS
188
189 my($file, $comment) = /^(\S+)\s*(.*)/;
190 next unless $file;
191
db5fd395 192 if ($Is_MacOS) {
0e3309e2
MS
193 $file = _macify($file);
194 $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
db5fd395
CN
195 }
196 elsif ($Is_VMS) {
f6d6199c 197 require File::Basename;
9607fc9c
PP
198 my($base,$dir) = File::Basename::fileparse($file);
199 # Resolve illegal file specifications in the same way as tar
200 $dir =~ tr/./_/;
201 my(@pieces) = split(/\./,$base);
202 if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
203 my $okfile = "$dir$base";
204 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
349e1be1 205 $file = $okfile;
f6d6199c 206 $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
9607fc9c 207 }
0e3309e2
MS
208
209 $read->{$file} = $comment;
005c1a0e
AD
210 }
211 close M;
212 $read;
213}
214
215# returns an anonymous sub that decides if an argument matches
216sub _maniskip {
005c1a0e 217 my @skip ;
45bc4d3a 218 my $mfile = "$MANIFEST.SKIP";
005c1a0e 219 local *M;
f6d6199c 220 open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
005c1a0e
AD
221 while (<M>){
222 chomp;
15a074ca 223 next if /^#/;
005c1a0e 224 next if /^\s*$/;
db5fd395 225 push @skip, _macify($_);
005c1a0e
AD
226 }
227 close M;
f6d6199c
MS
228 my $opts = $Is_VMS ? '(?i)' : '';
229
230 # Make sure each entry is isolated in its own parentheses, in case
231 # any of them contain alternations
232 my $regex = join '|', map "(?:$_)", @skip;
233
45bc4d3a 234 return sub { $_[0] =~ qr{$opts$regex} };
005c1a0e
AD
235}
236
237sub manicopy {
8e07c86e 238 my($read,$target,$how)=@_;
005c1a0e 239 croak "manicopy() called without target argument" unless defined $target;
15a074ca 240 $how ||= 'cp';
005c1a0e
AD
241 require File::Path;
242 require File::Basename;
57b1a898 243
8e07c86e 244 $target = VMS::Filespec::unixify($target) if $Is_VMS;
553c0e07 245 File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
57b1a898 246 foreach my $file (keys %$read){
db5fd395
CN
247 if ($Is_MacOS) {
248 if ($file =~ m!:!) {
249 my $dir = _maccat($target, $file);
250 $dir =~ s/[^:]+$//;
251 File::Path::mkpath($dir,1,0755);
252 }
253 cp_if_diff($file, _maccat($target, $file), $how);
254 } else {
255 $file = VMS::Filespec::unixify($file) if $Is_VMS;
256 if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
257 my $dir = File::Basename::dirname($file);
258 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
259 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
260 }
261 cp_if_diff($file, "$target/$file", $how);
84876ac5 262 }
005c1a0e
AD
263 }
264}
265
266sub cp_if_diff {
8a1da95f 267 my($from, $to, $how)=@_;
15a074ca 268 -f $from or carp "$0: $from not found";
8e07c86e
AD
269 my($diff) = 0;
270 local(*F,*T);
57b1a898 271 open(F,"< $from\0") or die "Can't read $from: $!\n";
db5fd395 272 if (open(T,"< $to\0")) {
8e07c86e
AD
273 while (<F>) { $diff++,last if $_ ne <T>; }
274 $diff++ unless eof(T);
275 close T;
276 }
277 else { $diff++; }
278 close F;
279 if ($diff) {
280 if (-e $to) {
281 unlink($to) or confess "unlink $to: $!";
282 }
15a074ca
AK
283 STRICT_SWITCH: {
284 best($from,$to), last STRICT_SWITCH if $how eq 'best';
285 cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
286 ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
287 croak("ExtUtils::Manifest::cp_if_diff " .
288 "called with illegal how argument [$how]. " .
289 "Legal values are 'best', 'cp', and 'ln'.");
290 }
8e07c86e
AD
291 }
292}
293
8e07c86e
AD
294sub cp {
295 my ($srcFile, $dstFile) = @_;
79dd614e
PP
296 my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
297 copy($srcFile,$dstFile);
9607fc9c 298 utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
8e07c86e 299 # chmod a+rX-w,go-w
45bc4d3a
JH
300 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile )
301 unless ($^O eq 'MacOS');
8e07c86e
AD
302}
303
304sub ln {
305 my ($srcFile, $dstFile) = @_;
f0f13d0e 306 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
8e07c86e 307 link($srcFile, $dstFile);
57b1a898
MS
308
309 # chmod a+r,go-w+X (except "X" only applies to u=x)
310 local($_) = $dstFile;
8e07c86e 311 my $mode= 0444 | (stat)[2] & 0700;
4e6ea2c3 312 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
57b1a898
MS
313 unlink $dstFile;
314 return;
4e6ea2c3
GS
315 }
316 1;
8e07c86e
AD
317}
318
57b1a898
MS
319unless (defined $Config{d_link}) {
320 # Really cool fix from Ilya :)
321 local $SIG{__WARN__} = sub {
322 warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
323 };
324 *ln = \&cp;
325}
326
327
328
329
4633a7c4
LW
330sub best {
331 my ($srcFile, $dstFile) = @_;
332 if (-l $srcFile) {
333 cp($srcFile, $dstFile);
334 } else {
3dee4013 335 ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
4633a7c4
LW
336 }
337}
338
db5fd395
CN
339sub _macify {
340 my($file) = @_;
341
342 return $file unless $Is_MacOS;
343
344 $file =~ s|^\./||;
345 if ($file =~ m|/|) {
346 $file =~ s|/+|:|g;
347 $file = ":$file";
348 }
349
350 $file;
351}
352
353sub _maccat {
354 my($f1, $f2) = @_;
355
356 return "$f1/$f2" unless $Is_MacOS;
357
358 $f1 .= ":$f2";
359 $f1 =~ s/([^:]:):/$1/g;
360 return $f1;
361}
362
363sub _unmacify {
364 my($file) = @_;
365
366 return $file unless $Is_MacOS;
367
368 $file =~ s|^:||;
369 $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
370 $file =~ y|:|/|;
371
372 $file;
373}
374
005c1a0e 3751;
79dd614e
PP
376
377__END__
378
379=head1 NAME
380
381ExtUtils::Manifest - utilities to write and check a MANIFEST file
382
383=head1 SYNOPSIS
384
d962e1c0 385 require ExtUtils::Manifest;
79dd614e 386
d962e1c0 387 ExtUtils::Manifest::mkmanifest;
79dd614e 388
d962e1c0 389 ExtUtils::Manifest::manicheck;
79dd614e 390
d962e1c0 391 ExtUtils::Manifest::filecheck;
79dd614e 392
d962e1c0 393 ExtUtils::Manifest::fullcheck;
79dd614e 394
d962e1c0 395 ExtUtils::Manifest::skipcheck;
79dd614e 396
d962e1c0 397 ExtUtils::Manifest::manifind();
79dd614e 398
d962e1c0 399 ExtUtils::Manifest::maniread($file);
79dd614e 400
d962e1c0 401 ExtUtils::Manifest::manicopy($read,$target,$how);
79dd614e
PP
402
403=head1 DESCRIPTION
404
d962e1c0 405mkmanifest() writes all files in and below the current directory to a
79dd614e
PP
406file named in the global variable $ExtUtils::Manifest::MANIFEST (which
407defaults to C<MANIFEST>) in the current directory. It works similar to
408
409 find . -print
410
411but in doing so checks each line in an existing C<MANIFEST> file and
412includes any comments that are found in the existing C<MANIFEST> file
413in the new one. Anything between white space and an end of line within
414a C<MANIFEST> file is considered to be a comment. Filenames and
de592821 415comments are separated by one or more TAB characters in the
79dd614e
PP
416output. All files that match any regular expression in a file
417C<MANIFEST.SKIP> (if such a file exists) are ignored.
418
e258e381
NC
419manicheck() checks if all the files within a C<MANIFEST> in the current
420directory really do exist. If C<MANIFEST> and the tree below the current
421directory are in sync it exits silently, returning an empty list. Otherwise
422it returns a list of files which are listed in the C<MANIFEST> but missing
423from the directory, and by default also outputs these names to STDERR.
79dd614e 424
d962e1c0 425filecheck() finds files below the current directory that are not
79dd614e
PP
426mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
427will be consulted. Any file matching a regular expression in such a
e258e381
NC
428file will not be reported as missing in the C<MANIFEST> file. The list of
429any extraneous files found is returned, and by default also reported to
430STDERR.
79dd614e 431
e258e381
NC
432fullcheck() does both a manicheck() and a filecheck(), returning references
433to two arrays, the first for files manicheck() found to be missing, the
434seond for unexpeced files found by filecheck().
79dd614e 435
d962e1c0 436skipcheck() lists all the files that are skipped due to your
79dd614e
PP
437C<MANIFEST.SKIP> file.
438
d962e1c0 439manifind() returns a hash reference. The keys of the hash are the
79dd614e
PP
440files found below the current directory.
441
d962e1c0 442maniread($file) reads a named C<MANIFEST> file (defaults to
79dd614e
PP
443C<MANIFEST> in the current directory) and returns a HASH reference
444with files being the keys and comments being the values of the HASH.
15a074ca
AK
445Blank lines and lines which start with C<#> in the C<MANIFEST> file
446are discarded.
79dd614e 447
d962e1c0 448C<manicopy($read,$target,$how)> copies the files that are the keys in
79dd614e 449the HASH I<%$read> to the named target directory. The HASH reference
d962e1c0 450$read is typically returned by the maniread() function. This
79dd614e
PP
451function is useful for producing a directory tree identical to the
452intended distribution tree. The third parameter $how can be used to
453specify a different methods of "copying". Valid values are C<cp>,
454which actually copies the files, C<ln> which creates hard links, and
455C<best> which mostly links the files but copies any symbolic link to
456make a tree without any symbolic link. Best is the default.
457
458=head1 MANIFEST.SKIP
459
460The file MANIFEST.SKIP may contain regular expressions of files that
461should be ignored by mkmanifest() and filecheck(). The regular
15a074ca
AK
462expressions should appear one on each line. Blank lines and lines
463which start with C<#> are skipped. Use C<\#> if you need a regular
464expression to start with a sharp character. A typical example:
79dd614e 465
0b9c804f 466 # Version control files and dirs.
79dd614e 467 \bRCS\b
0b9c804f
MS
468 \bCVS\b
469 ,v$
470
471 # Makemaker generated files and dirs.
79dd614e
PP
472 ^MANIFEST\.
473 ^Makefile$
79dd614e
PP
474 ^blib/
475 ^MakeMaker-\d
476
0b9c804f
MS
477 # Temp, old and emacs backup files.
478 ~$
479 \.old$
480 ^#.*#$
cfcce72b 481 ^\.#
0b9c804f
MS
482
483If no MANIFEST.SKIP file is found, a default set of skips will be
484used, similar to the example above. If you want nothing skipped,
485simply make an empty MANIFEST.SKIP file.
486
487
79dd614e
PP
488=head1 EXPORT_OK
489
490C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
491C<&maniread>, and C<&manicopy> are exportable.
492
493=head1 GLOBAL VARIABLES
494
495C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
496results in both a different C<MANIFEST> and a different
497C<MANIFEST.SKIP> file. This is useful if you want to maintain
498different distributions for different audiences (say a user version
499and a developer version including RCS).
500
81ff29e3 501C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
79dd614e
PP
502all functions act silently.
503
0b9c804f
MS
504C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value,
505or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
506produced.
507
79dd614e
PP
508=head1 DIAGNOSTICS
509
510All diagnostic output is sent to C<STDERR>.
511
bbc7dcd2 512=over 4
79dd614e
PP
513
514=item C<Not in MANIFEST:> I<file>
515
45bc4d3a
JH
516is reported if a file is found which is not in C<MANIFEST>.
517
518=item C<Skipping> I<file>
519
520is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
79dd614e
PP
521
522=item C<No such file:> I<file>
523
524is reported if a file mentioned in a C<MANIFEST> file does not
525exist.
526
527=item C<MANIFEST:> I<$!>
528
529is reported if C<MANIFEST> could not be opened.
530
531=item C<Added to MANIFEST:> I<file>
532
533is reported by mkmanifest() if $Verbose is set and a file is added
534to MANIFEST. $Verbose is set to 1 by default.
535
536=back
537
0b9c804f
MS
538=head1 ENVIRONMENT
539
540=over 4
541
542=item B<PERL_MM_MANIFEST_DEBUG>
543
544Turns on debugging
545
546=back
547
79dd614e
PP
548=head1 SEE ALSO
549
550L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
551
552=head1 AUTHOR
553
e309c560 554Andreas Koenig <F<andreas.koenig@anima.de>>
79dd614e
PP
555
556=cut