ExtUtils::MakeMaker 6.10_03 -> 6.10_04
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm
CommitLineData
005c1a0e 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 9use strict;
10
57b1a898 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 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 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 32my $Filename = __FILE__;
33$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
57b1a898 34 "$MANIFEST.SKIP";
4e68a208 35
479d2113 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 88sub _sort {
89 return sort { lc $a cmp lc $b } @_;
90}
91
005c1a0e 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 97 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
98 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
f6d6199c 99 my $skip = _maniskip();
005c1a0e 100 my $found = manifind();
101 my($key,$val,$file,%all);
f1387719 102 %all = (%$found, %$read);
84876ac5 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 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 118 my $tabs = (5 - (length($file)+1)/8);
119 $tabs = 1 if $tabs < 1;
8e07c86e 120 $tabs = 0 unless $text;
121 print M $file, "\t" x $tabs, $text, "\n";
005c1a0e 122 }
123 close M;
124}
125
f6d6199c 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 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 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 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 166 $Is_MacOS ? ":" : ".");
167
168 return $found;
005c1a0e 169}
170
479d2113 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 184
185sub manicheck {
45bc4d3a 186 return _check_files();
005c1a0e 187}
188
479d2113 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 205}
206
479d2113 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 232 my($p) = @_;
233 my $found = manifind();
234 my $matches = _maniskip();
235
236 my @skipped = ();
dedf98bc 237 foreach my $file (_sort keys %$found){
45bc4d3a 238 if (&$matches($file)){
239 warn "Skipping $file\n";
240 push @skipped, $file;
241 next;
242 }
243 }
244
245 return @skipped;
8e07c86e 246}
247
f6d6199c 248
45bc4d3a 249sub _check_files {
250 my $p = shift;
39e571d4 251 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
45bc4d3a 252 my $read = maniread() || {};
253 my $found = manifind($p);
254
255 my(@missfile) = ();
dedf98bc 256 foreach my $file (_sort keys %$read){
45bc4d3a 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 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 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 289
290 return @missentry;
005c1a0e 291}
292
45bc4d3a 293
479d2113 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 306sub maniread {
307 my ($mfile) = @_;
15a074ca 308 $mfile ||= $MANIFEST;
005c1a0e 309 my $read = {};
310 local *M;
311 unless (open M, $mfile){
2530b651 312 warn "$mfile: $!";
313 return $read;
005c1a0e 314 }
2530b651 315 local $_;
005c1a0e 316 while (<M>){
2530b651 317 chomp;
318 next if /^#/;
0e3309e2 319
320 my($file, $comment) = /^(\S+)\s*(.*)/;
321 next unless $file;
322
2530b651 323 if ($Is_MacOS) {
324 $file = _macify($file);
325 $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
326 }
327 elsif ($Is_VMS) {
328 require File::Basename;
329 my($base,$dir) = File::Basename::fileparse($file);
330 # Resolve illegal file specifications in the same way as tar
331 $dir =~ tr/./_/;
332 my(@pieces) = split(/\./,$base);
333 if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
334 my $okfile = "$dir$base";
335 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
349e1be1 336 $file = $okfile;
f6d6199c 337 $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
2530b651 338 }
0e3309e2 339
340 $read->{$file} = $comment;
005c1a0e 341 }
342 close M;
343 $read;
344}
345
346# returns an anonymous sub that decides if an argument matches
347sub _maniskip {
005c1a0e 348 my @skip ;
45bc4d3a 349 my $mfile = "$MANIFEST.SKIP";
2530b651 350 local(*M,$_);
f6d6199c 351 open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
005c1a0e 352 while (<M>){
353 chomp;
15a074ca 354 next if /^#/;
005c1a0e 355 next if /^\s*$/;
db5fd395 356 push @skip, _macify($_);
005c1a0e 357 }
358 close M;
f6d6199c 359 my $opts = $Is_VMS ? '(?i)' : '';
360
361 # Make sure each entry is isolated in its own parentheses, in case
362 # any of them contain alternations
363 my $regex = join '|', map "(?:$_)", @skip;
364
45bc4d3a 365 return sub { $_[0] =~ qr{$opts$regex} };
005c1a0e 366}
367
479d2113 368=item manicopy
369
370 manicopy($src, $dest_dir);
371 manicopy($src, $dest_dir, $how);
372
373copies the files that are the keys in the HASH I<%$src> to the
374$dest_dir. The HASH reference $read is typically returned by the
375maniread() function. This function is useful for producing a directory
376tree identical to the intended distribution tree. The third parameter
377$how can be used to specify a different methods of "copying". Valid
378values are C<cp>, which actually copies the files, C<ln> which creates
379hard links, and C<best> which mostly links the files but copies any
380symbolic link to make a tree without any symbolic link. Best is the
381default.
382
383=cut
384
005c1a0e 385sub manicopy {
8e07c86e 386 my($read,$target,$how)=@_;
005c1a0e 387 croak "manicopy() called without target argument" unless defined $target;
15a074ca 388 $how ||= 'cp';
005c1a0e 389 require File::Path;
390 require File::Basename;
57b1a898 391
8e07c86e 392 $target = VMS::Filespec::unixify($target) if $Is_VMS;
553c0e07 393 File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
57b1a898 394 foreach my $file (keys %$read){
db5fd395 395 if ($Is_MacOS) {
396 if ($file =~ m!:!) {
397 my $dir = _maccat($target, $file);
398 $dir =~ s/[^:]+$//;
399 File::Path::mkpath($dir,1,0755);
400 }
401 cp_if_diff($file, _maccat($target, $file), $how);
402 } else {
403 $file = VMS::Filespec::unixify($file) if $Is_VMS;
404 if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
405 my $dir = File::Basename::dirname($file);
406 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
407 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
408 }
409 cp_if_diff($file, "$target/$file", $how);
84876ac5 410 }
005c1a0e 411 }
412}
413
414sub cp_if_diff {
8a1da95f 415 my($from, $to, $how)=@_;
15a074ca 416 -f $from or carp "$0: $from not found";
8e07c86e 417 my($diff) = 0;
418 local(*F,*T);
57b1a898 419 open(F,"< $from\0") or die "Can't read $from: $!\n";
db5fd395 420 if (open(T,"< $to\0")) {
2530b651 421 local $_;
8e07c86e 422 while (<F>) { $diff++,last if $_ ne <T>; }
423 $diff++ unless eof(T);
424 close T;
425 }
426 else { $diff++; }
427 close F;
428 if ($diff) {
429 if (-e $to) {
430 unlink($to) or confess "unlink $to: $!";
431 }
15a074ca 432 STRICT_SWITCH: {
433 best($from,$to), last STRICT_SWITCH if $how eq 'best';
434 cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
435 ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
436 croak("ExtUtils::Manifest::cp_if_diff " .
437 "called with illegal how argument [$how]. " .
438 "Legal values are 'best', 'cp', and 'ln'.");
439 }
8e07c86e 440 }
441}
442
8e07c86e 443sub cp {
444 my ($srcFile, $dstFile) = @_;
79dd614e 445 my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
446 copy($srcFile,$dstFile);
9607fc9c 447 utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
8e07c86e 448 # chmod a+rX-w,go-w
45bc4d3a 449 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile )
450 unless ($^O eq 'MacOS');
8e07c86e 451}
452
453sub ln {
454 my ($srcFile, $dstFile) = @_;
f0f13d0e 455 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
8e07c86e 456 link($srcFile, $dstFile);
57b1a898 457
458 # chmod a+r,go-w+X (except "X" only applies to u=x)
459 local($_) = $dstFile;
8e07c86e 460 my $mode= 0444 | (stat)[2] & 0700;
4e6ea2c3 461 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
57b1a898 462 unlink $dstFile;
463 return;
4e6ea2c3 464 }
465 1;
8e07c86e 466}
467
57b1a898 468unless (defined $Config{d_link}) {
469 # Really cool fix from Ilya :)
470 local $SIG{__WARN__} = sub {
471 warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
472 };
473 *ln = \&cp;
474}
475
476
477
478
4633a7c4 479sub best {
480 my ($srcFile, $dstFile) = @_;
481 if (-l $srcFile) {
482 cp($srcFile, $dstFile);
483 } else {
3dee4013 484 ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
4633a7c4 485 }
486}
487
db5fd395 488sub _macify {
489 my($file) = @_;
490
491 return $file unless $Is_MacOS;
492
493 $file =~ s|^\./||;
494 if ($file =~ m|/|) {
495 $file =~ s|/+|:|g;
496 $file = ":$file";
497 }
498
499 $file;
500}
501
502sub _maccat {
503 my($f1, $f2) = @_;
504
505 return "$f1/$f2" unless $Is_MacOS;
506
507 $f1 .= ":$f2";
508 $f1 =~ s/([^:]:):/$1/g;
509 return $f1;
510}
511
512sub _unmacify {
513 my($file) = @_;
514
515 return $file unless $Is_MacOS;
516
517 $file =~ s|^:||;
518 $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
519 $file =~ y|:|/|;
520
521 $file;
522}
523
79dd614e 524
479d2113 525=item maniadd
79dd614e 526
479d2113 527 maniadd({ $file => $comment, ...});
79dd614e 528
479d2113 529Adds an entry to an existing F<MANIFEST>.
79dd614e 530
479d2113 531$file will be normalized (ie. Unixified). B<UNIMPLEMENTED>
79dd614e 532
479d2113 533=cut
79dd614e 534
479d2113 535sub maniadd {
536 my($additions) = shift;
79dd614e 537
479d2113 538 _normalize($additions);
2530b651 539 _fix_manifest($MANIFEST);
79dd614e 540
479d2113 541 my $manifest = maniread();
542 open(MANIFEST, ">>$MANIFEST") or die "Could not open $MANIFEST: $!";
dedf98bc 543 foreach my $file (_sort keys %$additions) {
544 my $comment = $additions->{$file} || '';
479d2113 545 printf MANIFEST "%-40s%s\n", $file, $comment unless
546 exists $manifest->{$file};
547 }
548 close MANIFEST;
549}
79dd614e 550
2530b651 551
552# Sometimes MANIFESTs are missing a trailing newline. Fix this.
553sub _fix_manifest {
554 my $manifest_file = shift;
555
556 open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
557
558 # Yes, we should be using seek(), but I'd like to avoid loading POSIX
559 # to get SEEK_*
560 my @manifest = <MANIFEST>;
561 close MANIFEST;
562
563 unless( $manifest[-1] =~ /\n\z/ ) {
564 open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
565 print MANIFEST "\n";
566 close MANIFEST;
567 }
568}
569
570
479d2113 571# UNIMPLEMENTED
572sub _normalize {
573 return;
574}
79dd614e 575
79dd614e 576
479d2113 577=back
79dd614e 578
479d2113 579=head2 MANIFEST
79dd614e 580
479d2113 581Anything between white space and an end of line within a C<MANIFEST>
582file is considered to be a comment. Filenames and comments are
583separated by one or more TAB characters in the output.
79dd614e 584
79dd614e 585
479d2113 586=head2 MANIFEST.SKIP
79dd614e 587
588The file MANIFEST.SKIP may contain regular expressions of files that
589should be ignored by mkmanifest() and filecheck(). The regular
15a074ca 590expressions should appear one on each line. Blank lines and lines
591which start with C<#> are skipped. Use C<\#> if you need a regular
592expression to start with a sharp character. A typical example:
79dd614e 593
0b9c804f 594 # Version control files and dirs.
79dd614e 595 \bRCS\b
0b9c804f 596 \bCVS\b
597 ,v$
479d2113 598 \B\.svn\b
0b9c804f 599
600 # Makemaker generated files and dirs.
79dd614e 601 ^MANIFEST\.
602 ^Makefile$
79dd614e 603 ^blib/
604 ^MakeMaker-\d
605
0b9c804f 606 # Temp, old and emacs backup files.
607 ~$
608 \.old$
609 ^#.*#$
cfcce72b 610 ^\.#
0b9c804f 611
612If no MANIFEST.SKIP file is found, a default set of skips will be
613used, similar to the example above. If you want nothing skipped,
614simply make an empty MANIFEST.SKIP file.
615
616
479d2113 617=head2 EXPORT_OK
79dd614e 618
619C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
620C<&maniread>, and C<&manicopy> are exportable.
621
479d2113 622=head2 GLOBAL VARIABLES
79dd614e 623
624C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
625results in both a different C<MANIFEST> and a different
626C<MANIFEST.SKIP> file. This is useful if you want to maintain
627different distributions for different audiences (say a user version
628and a developer version including RCS).
629
81ff29e3 630C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
79dd614e 631all functions act silently.
632
0b9c804f 633C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value,
634or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
635produced.
636
79dd614e 637=head1 DIAGNOSTICS
638
639All diagnostic output is sent to C<STDERR>.
640
bbc7dcd2 641=over 4
79dd614e 642
643=item C<Not in MANIFEST:> I<file>
644
45bc4d3a 645is reported if a file is found which is not in C<MANIFEST>.
646
647=item C<Skipping> I<file>
648
649is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
79dd614e 650
651=item C<No such file:> I<file>
652
653is reported if a file mentioned in a C<MANIFEST> file does not
654exist.
655
656=item C<MANIFEST:> I<$!>
657
658is reported if C<MANIFEST> could not be opened.
659
660=item C<Added to MANIFEST:> I<file>
661
662is reported by mkmanifest() if $Verbose is set and a file is added
663to MANIFEST. $Verbose is set to 1 by default.
664
665=back
666
0b9c804f 667=head1 ENVIRONMENT
668
669=over 4
670
671=item B<PERL_MM_MANIFEST_DEBUG>
672
673Turns on debugging
674
675=back
676
79dd614e 677=head1 SEE ALSO
678
679L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
680
681=head1 AUTHOR
682
e309c560 683Andreas Koenig <F<andreas.koenig@anima.de>>
79dd614e 684
685=cut
479d2113 686
6871;