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