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