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