This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to MakeMaker 6.17.
[perl5.git] / lib / ExtUtils / Manifest.pm
1 package ExtUtils::Manifest;
2
3 require Exporter;
4 use Config;
5 use File::Find;
6 use File::Copy 'copy';
7 use File::Spec;
8 use Carp;
9 use strict;
10
11 use vars qw($VERSION @ISA @EXPORT_OK 
12           $Is_MacOS $Is_VMS 
13           $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
14
15 $VERSION = 1.42;
16 @ISA=('Exporter');
17 @EXPORT_OK = qw(mkmanifest
18                 manicheck  filecheck  fullcheck  skipcheck
19                 manifind   maniread   manicopy   maniadd
20                );
21
22 $Is_MacOS = $^O eq 'MacOS';
23 $Is_VMS   = $^O eq 'VMS';
24 require VMS::Filespec if $Is_VMS;
25
26 $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
27 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
28                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
29 $Quiet = 0;
30 $MANIFEST = 'MANIFEST';
31
32 my $Filename = __FILE__;
33 $DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
34                  "$MANIFEST.SKIP";
35
36
37 =head1 NAME
38
39 ExtUtils::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
65 ExtUtils::Manifest exports no functions by default.  The following are
66 exported on request
67
68 =over 4
69
70 =item mkmanifest
71
72     mkmanifest();
73
74 Writes all files in and below the current directory to your F<MANIFEST>.
75 It works similar to
76
77     find . > MANIFEST
78
79 All files that match any regular expression in a file F<MANIFEST.SKIP>
80 (if it exists) are ignored.
81
82 Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.  Lines
83 from the old F<MANIFEST> file is preserved, including any comments
84 that are found in the existing F<MANIFEST> file in the new one.
85
86 =cut
87
88 sub _sort {
89     return sort { lc $a cmp lc $b } @_;
90 }
91
92 sub mkmanifest {
93     my $manimiss = 0;
94     my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
95     $read = {} if $manimiss;
96     local *M;
97     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
98     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
99     my $skip = _maniskip();
100     my $found = manifind();
101     my($key,$val,$file,%all);
102     %all = (%$found, %$read);
103     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
104         if $manimiss; # add new MANIFEST to known file list
105     foreach $file (_sort keys %all) {
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         }
112         if ($Verbose){
113             warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
114         }
115         my $text = $all{$file};
116         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
117         $file = _unmacify($file);
118         my $tabs = (5 - (length($file)+1)/8);
119         $tabs = 1 if $tabs < 1;
120         $tabs = 0 unless $text;
121         print M $file, "\t" x $tabs, $text, "\n";
122     }
123     close M;
124 }
125
126 # Geez, shouldn't this use File::Spec or File::Basename or something?  
127 # Why so careful about dependencies?
128 sub clean_up_filename {
129   my $filename = shift;
130   $filename =~ s|^\./||;
131   $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
132   return $filename;
133 }
134
135
136 =item manifind
137
138     my $found = manifind();
139
140 returns a hash reference. The keys of the hash are the files found
141 below the current directory.
142
143 =cut
144
145 sub manifind {
146     my $p = shift || {};
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;
152         return if -d $_;
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.
165     find({wanted => $wanted},
166          $Is_MacOS ? ":" : ".");
167
168     return $found;
169 }
170
171
172 =item manicheck
173
174     my @missing_files = manicheck();
175
176 checks if all the files within a C<MANIFEST> in the current directory
177 really do exist. If C<MANIFEST> and the tree below the current
178 directory are in sync it silently returns an empty list.
179 Otherwise it returns a list of files which are listed in the
180 C<MANIFEST> but missing from the directory, and by default also
181 outputs these names to STDERR.
182
183 =cut
184
185 sub manicheck {
186     return _check_files();
187 }
188
189
190 =item filecheck
191
192     my @extra_files = filecheck();
193
194 finds files below the current directory that are not mentioned in the
195 C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
196 consulted. Any file matching a regular expression in such a file will
197 not be reported as missing in the C<MANIFEST> file. The list of any
198 extraneous files found is returned, and by default also reported to
199 STDERR.
200
201 =cut
202
203 sub filecheck {
204     return _check_manifest();
205 }
206
207
208 =item fullcheck
209
210     my($missing, $extra) = fullcheck();
211
212 does both a manicheck() and a filecheck(), returning then as two array
213 refs.
214
215 =cut
216
217 sub fullcheck {
218     return [_check_files()], [_check_manifest()];
219 }
220
221
222 =item skipcheck
223
224     my @skipped = skipcheck();
225
226 lists all the files that are skipped due to your C<MANIFEST.SKIP>
227 file.
228
229 =cut
230
231 sub skipcheck {
232     my($p) = @_;
233     my $found = manifind();
234     my $matches = _maniskip();
235
236     my @skipped = ();
237     foreach my $file (_sort keys %$found){
238         if (&$matches($file)){
239             warn "Skipping $file\n";
240             push @skipped, $file;
241             next;
242         }
243     }
244
245     return @skipped;
246 }
247
248
249 sub _check_files {
250     my $p = shift;
251     my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
252     my $read = maniread() || {};
253     my $found = manifind($p);
254
255     my(@missfile) = ();
256     foreach my $file (_sort keys %$read){
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         }
267     }
268
269     return @missfile;
270 }
271
272
273 sub _check_manifest {
274     my($p) = @_;
275     my $read = maniread() || {};
276     my $found = manifind($p);
277     my $skip  = _maniskip();
278
279     my @missentry = ();
280     foreach my $file (_sort keys %$found){
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         }
288     }
289
290     return @missentry;
291 }
292
293
294 =item maniread
295
296     my $manifest = maniread();
297     my $manifest = maniread($manifest_file);
298
299 reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
300 directory) and returns a HASH reference with files being the keys and
301 comments being the values of the HASH.  Blank lines and lines which
302 start with C<#> in the C<MANIFEST> file are discarded.
303
304 =cut
305
306 sub maniread {
307     my ($mfile) = @_;
308     $mfile ||= $MANIFEST;
309     my $read = {};
310     local *M;
311     unless (open M, $mfile){
312         warn "$mfile: $!";
313         return $read;
314     }
315     local $_;
316     while (<M>){
317         chomp;
318         next if /^\s*#/;
319
320         my($file, $comment) = /^(\S+)\s*(.*)/;
321         next unless $file;
322
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;
336             $file = $okfile;
337             $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
338         }
339
340         $read->{$file} = $comment;
341     }
342     close M;
343     $read;
344 }
345
346 # returns an anonymous sub that decides if an argument matches
347 sub _maniskip {
348     my @skip ;
349     my $mfile = "$MANIFEST.SKIP";
350     local(*M,$_);
351     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
352     while (<M>){
353         chomp;
354         next if /^#/;
355         next if /^\s*$/;
356         push @skip, _macify($_);
357     }
358     close M;
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
365     return sub { $_[0] =~ qr{$opts$regex} };
366 }
367
368 =item manicopy
369
370     manicopy($src, $dest_dir);
371     manicopy($src, $dest_dir, $how);
372
373 copies 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
375 maniread() function. This function is useful for producing a directory
376 tree identical to the intended distribution tree. The third parameter
377 $how can be used to specify a different methods of "copying". Valid
378 values are C<cp>, which actually copies the files, C<ln> which creates
379 hard links, and C<best> which mostly links the files but copies any
380 symbolic link to make a tree without any symbolic link. Best is the
381 default.
382
383 =cut
384
385 sub manicopy {
386     my($read,$target,$how)=@_;
387     croak "manicopy() called without target argument" unless defined $target;
388     $how ||= 'cp';
389     require File::Path;
390     require File::Basename;
391
392     $target = VMS::Filespec::unixify($target) if $Is_VMS;
393     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
394     foreach my $file (keys %$read){
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);
410         }
411     }
412 }
413
414 sub cp_if_diff {
415     my($from, $to, $how)=@_;
416     -f $from or carp "$0: $from not found";
417     my($diff) = 0;
418     local(*F,*T);
419     open(F,"< $from\0") or die "Can't read $from: $!\n";
420     if (open(T,"< $to\0")) {
421         local $_;
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         }
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         }
440     }
441 }
442
443 sub cp {
444     my ($srcFile, $dstFile) = @_;
445     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
446     copy($srcFile,$dstFile);
447     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
448     # chmod a+rX-w,go-w
449     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) 
450       unless ($^O eq 'MacOS');
451 }
452
453 sub ln {
454     my ($srcFile, $dstFile) = @_;
455     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
456     link($srcFile, $dstFile);
457
458     # chmod a+r,go-w+X (except "X" only applies to u=x)
459     local($_) = $dstFile;
460     my $mode= 0444 | (stat)[2] & 0700;
461     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
462         unlink $dstFile;
463         return;
464     }
465     1;
466 }
467
468 unless (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
479 sub best {
480     my ($srcFile, $dstFile) = @_;
481     if (-l $srcFile) {
482         cp($srcFile, $dstFile);
483     } else {
484         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
485     }
486 }
487
488 sub _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
502 sub _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
512 sub _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
524
525 =item maniadd
526
527   maniadd({ $file => $comment, ...});
528
529 Adds an entry to an existing F<MANIFEST> unless its already there.
530
531 $file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
532
533 =cut
534
535 sub maniadd {
536     my($additions) = shift;
537
538     _normalize($additions);
539     _fix_manifest($MANIFEST);
540
541     my $manifest = maniread();
542     my @needed = grep { !exists $manifest->{$_} } keys %$additions;
543     return 1 unless @needed;
544
545     open(MANIFEST, ">>$MANIFEST") or 
546       die "maniadd() could not open $MANIFEST: $!";
547
548     foreach my $file (_sort @needed) {
549         my $comment = $additions->{$file} || '';
550         printf MANIFEST "%-40s %s\n", $file, $comment;
551     }
552     close MANIFEST or die "Error closing $MANIFEST: $!";
553
554     return 1;
555 }
556
557
558 # Sometimes MANIFESTs are missing a trailing newline.  Fix this.
559 sub _fix_manifest {
560     my $manifest_file = shift;
561
562     open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
563
564     # Yes, we should be using seek(), but I'd like to avoid loading POSIX
565     # to get SEEK_*
566     my @manifest = <MANIFEST>;
567     close MANIFEST;
568
569     unless( $manifest[-1] =~ /\n\z/ ) {
570         open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
571         print MANIFEST "\n";
572         close MANIFEST;
573     }
574 }
575         
576
577 # UNIMPLEMENTED
578 sub _normalize {
579     return;
580 }
581
582
583 =back
584
585 =head2 MANIFEST
586
587 Anything between white space and an end of line within a C<MANIFEST>
588 file is considered to be a comment.  Filenames and comments are
589 separated by one or more TAB characters in the output. 
590
591
592 =head2 MANIFEST.SKIP
593
594 The file MANIFEST.SKIP may contain regular expressions of files that
595 should be ignored by mkmanifest() and filecheck(). The regular
596 expressions should appear one on each line. Blank lines and lines
597 which start with C<#> are skipped.  Use C<\#> if you need a regular
598 expression to start with a sharp character. A typical example:
599
600     # Version control files and dirs.
601     \bRCS\b
602     \bCVS\b
603     ,v$
604     \B\.svn\b
605
606     # Makemaker generated files and dirs.
607     ^MANIFEST\.
608     ^Makefile$
609     ^blib/
610     ^MakeMaker-\d
611
612     # Temp, old and emacs backup files.
613     ~$
614     \.old$
615     ^#.*#$
616     ^\.#
617
618 If no MANIFEST.SKIP file is found, a default set of skips will be
619 used, similar to the example above.  If you want nothing skipped,
620 simply make an empty MANIFEST.SKIP file.
621
622
623 =head2 EXPORT_OK
624
625 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
626 C<&maniread>, and C<&manicopy> are exportable.
627
628 =head2 GLOBAL VARIABLES
629
630 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
631 results in both a different C<MANIFEST> and a different
632 C<MANIFEST.SKIP> file. This is useful if you want to maintain
633 different distributions for different audiences (say a user version
634 and a developer version including RCS).
635
636 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
637 all functions act silently.
638
639 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
640 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
641 produced.
642
643 =head1 DIAGNOSTICS
644
645 All diagnostic output is sent to C<STDERR>.
646
647 =over 4
648
649 =item C<Not in MANIFEST:> I<file>
650
651 is reported if a file is found which is not in C<MANIFEST>.
652
653 =item C<Skipping> I<file>
654
655 is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
656
657 =item C<No such file:> I<file>
658
659 is reported if a file mentioned in a C<MANIFEST> file does not
660 exist.
661
662 =item C<MANIFEST:> I<$!>
663
664 is reported if C<MANIFEST> could not be opened.
665
666 =item C<Added to MANIFEST:> I<file>
667
668 is reported by mkmanifest() if $Verbose is set and a file is added
669 to MANIFEST. $Verbose is set to 1 by default.
670
671 =back
672
673 =head1 ENVIRONMENT
674
675 =over 4
676
677 =item B<PERL_MM_MANIFEST_DEBUG>
678
679 Turns on debugging
680
681 =back
682
683 =head1 SEE ALSO
684
685 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
686
687 =head1 AUTHOR
688
689 Andreas Koenig <F<andreas.koenig@anima.de>>
690
691 =cut
692
693 1;