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