1 package ExtUtils::Manifest;
7 use File::Spec::Functions qw(splitpath);
11 our ($VERSION,@ISA,@EXPORT_OK,
13 $Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);
17 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
18 'skipcheck', 'maniread', 'manicopy');
20 $Is_MacOS = $^O eq 'MacOS';
21 $Is_VMS = $^O eq 'VMS';
22 require VMS::Filespec if $Is_VMS;
24 $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
25 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
26 $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
28 $MANIFEST = 'MANIFEST';
29 $DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";
31 # Really cool fix from Ilya :)
32 unless (defined $Config{d_link}) {
39 my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
40 $read = {} if $manimiss;
42 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
43 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
44 my $skip = _maniskip();
45 my $found = manifind();
46 my($key,$val,$file,%all);
47 %all = (%$found, %$read);
48 $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
49 if $manimiss; # add new MANIFEST to known file list
50 foreach $file (sort keys %all) {
52 # Policy: only remove files if they're listed in MANIFEST.SKIP.
53 # Don't remove files just because they don't exist.
54 warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
58 warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
60 my $text = $all{$file};
61 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
62 $file = _unmacify($file);
63 my $tabs = (5 - (length($file)+1)/8);
64 $tabs = 1 if $tabs < 1;
65 $tabs = 0 unless $text;
66 print M $file, "\t" x $tabs, $text, "\n";
71 # Geez, shouldn't this use File::Spec or File::Basename or something?
72 # Why so careful about dependencies?
73 sub clean_up_filename {
75 $filename =~ s|^\./||;
76 $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
82 my $skip = _maniskip(warn => $p->{warn_on_skip});
86 my $name = clean_up_filename($File::Find::name);
87 warn "Debug: diskfile $name\n" if $Debug;
88 return if $skip->($name) or -d $name;
91 $name =~ s#(.*)\.$#\L$1#;
92 $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
97 # We have to use "$File::Find::dir/$_" in preprocess, because
98 # $File::Find::name is unavailable.
99 # Also, it's okay to use / here, because MANIFEST files use Unix-style
101 find({wanted => $wanted,
103 sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
106 $Is_MacOS ? ":" : ".");
112 _manicheck({check_files => 1, check_MANIFEST => 1});
116 return @{(_manicheck({check_files => 1}))[0]};
120 return @{(_manicheck({check_MANIFEST => 1}))[1]};
124 _manicheck({check_MANIFEST => 1, warn_on_skip => 1});
129 my $read = maniread();
130 my $found = manifind($p);
133 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
134 my(@missfile,@missentry);
135 if ($p->{check_files}){
136 foreach $file (sort keys %$read){
137 warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
140 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
141 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
143 unless ( exists $found->{$file} ) {
144 warn "No such file: $file\n" unless $Quiet;
145 push @missfile, $file;
149 if ($p->{check_MANIFEST}){
151 my $matches = _maniskip();
152 foreach $file (sort keys %$found){
153 if (&$matches($file)){
154 warn "Skipping $file\n" if $p->{warn_on_skip};
157 warn "Debug: manicheck checking from disk $file\n" if $Debug;
158 unless ( exists $read->{$file} ) {
159 my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
160 warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
161 push @missentry, $file;
165 (\@missfile,\@missentry);
170 $mfile ||= $MANIFEST;
173 unless (open M, $mfile){
181 my($file, $comment) = /^(\S+)\s*(.*)/;
185 $file = _macify($file);
186 $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
189 require File::Basename;
190 my($base,$dir) = File::Basename::fileparse($file);
191 # Resolve illegal file specifications in the same way as tar
193 my(@pieces) = split(/\./,$base);
194 if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
195 my $okfile = "$dir$base";
196 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
198 $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
201 $read->{$file} = $comment;
207 # returns an anonymous sub that decides if an argument matches
212 my $mfile ||= "$MANIFEST.SKIP";
214 open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
219 push @skip, _macify($_);
222 my $opts = $Is_VMS ? '(?i)' : '';
224 # Make sure each entry is isolated in its own parentheses, in case
225 # any of them contain alternations
226 my $regex = join '|', map "(?:$_)", @skip;
229 ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
230 : sub { $_[0] =~ qr{$opts$regex} }
235 my($read,$target,$how)=@_;
236 croak "manicopy() called without target argument" unless defined $target;
239 require File::Basename;
241 $target = VMS::Filespec::unixify($target) if $Is_VMS;
242 File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
243 foreach $file (keys %$read){
246 my $dir = _maccat($target, $file);
248 File::Path::mkpath($dir,1,0755);
250 cp_if_diff($file, _maccat($target, $file), $how);
252 $file = VMS::Filespec::unixify($file) if $Is_VMS;
253 if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
254 my $dir = File::Basename::dirname($file);
255 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
256 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
258 cp_if_diff($file, "$target/$file", $how);
264 my($from, $to, $how)=@_;
265 -f $from or carp "$0: $from not found";
268 open(F,"< $from\0") or croak "Can't read $from: $!\n";
269 if (open(T,"< $to\0")) {
270 while (<F>) { $diff++,last if $_ ne <T>; }
271 $diff++ unless eof(T);
278 unlink($to) or confess "unlink $to: $!";
281 best($from,$to), last STRICT_SWITCH if $how eq 'best';
282 cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
283 ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
284 croak("ExtUtils::Manifest::cp_if_diff " .
285 "called with illegal how argument [$how]. " .
286 "Legal values are 'best', 'cp', and 'ln'.");
292 my ($srcFile, $dstFile) = @_;
293 my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
294 copy($srcFile,$dstFile);
295 utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
297 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS');
301 my ($srcFile, $dstFile) = @_;
302 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
303 link($srcFile, $dstFile);
304 local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
305 my $mode= 0444 | (stat)[2] & 0700;
306 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
314 my ($srcFile, $dstFile) = @_;
316 cp($srcFile, $dstFile);
318 ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
325 return $file unless $Is_MacOS;
339 return "$f1/$f2" unless $Is_MacOS;
342 $f1 =~ s/([^:]:):/$1/g;
349 return $file unless $Is_MacOS;
352 $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
364 ExtUtils::Manifest - utilities to write and check a MANIFEST file
368 require ExtUtils::Manifest;
370 ExtUtils::Manifest::mkmanifest;
372 ExtUtils::Manifest::manicheck;
374 ExtUtils::Manifest::filecheck;
376 ExtUtils::Manifest::fullcheck;
378 ExtUtils::Manifest::skipcheck;
380 ExtUtils::Manifest::manifind();
382 ExtUtils::Manifest::maniread($file);
384 ExtUtils::Manifest::manicopy($read,$target,$how);
388 mkmanifest() writes all files in and below the current directory to a
389 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
390 defaults to C<MANIFEST>) in the current directory. It works similar to
394 but in doing so checks each line in an existing C<MANIFEST> file and
395 includes any comments that are found in the existing C<MANIFEST> file
396 in the new one. Anything between white space and an end of line within
397 a C<MANIFEST> file is considered to be a comment. Filenames and
398 comments are separated by one or more TAB characters in the
399 output. All files that match any regular expression in a file
400 C<MANIFEST.SKIP> (if such a file exists) are ignored.
402 manicheck() checks if all the files within a C<MANIFEST> in the current
403 directory really do exist. If C<MANIFEST> and the tree below the current
404 directory are in sync it exits silently, returning an empty list. Otherwise
405 it returns a list of files which are listed in the C<MANIFEST> but missing
406 from the directory, and by default also outputs these names to STDERR.
408 filecheck() finds files below the current directory that are not
409 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
410 will be consulted. Any file matching a regular expression in such a
411 file will not be reported as missing in the C<MANIFEST> file. The list of
412 any extraneous files found is returned, and by default also reported to
415 fullcheck() does both a manicheck() and a filecheck(), returning references
416 to two arrays, the first for files manicheck() found to be missing, the
417 seond for unexpeced files found by filecheck().
419 skipcheck() lists all the files that are skipped due to your
420 C<MANIFEST.SKIP> file.
422 manifind() returns a hash reference. The keys of the hash are the
423 files found below the current directory.
425 maniread($file) reads a named C<MANIFEST> file (defaults to
426 C<MANIFEST> in the current directory) and returns a HASH reference
427 with files being the keys and comments being the values of the HASH.
428 Blank lines and lines which start with C<#> in the C<MANIFEST> file
431 C<manicopy($read,$target,$how)> copies the files that are the keys in
432 the HASH I<%$read> to the named target directory. The HASH reference
433 $read is typically returned by the maniread() function. This
434 function is useful for producing a directory tree identical to the
435 intended distribution tree. The third parameter $how can be used to
436 specify a different methods of "copying". Valid values are C<cp>,
437 which actually copies the files, C<ln> which creates hard links, and
438 C<best> which mostly links the files but copies any symbolic link to
439 make a tree without any symbolic link. Best is the default.
443 The file MANIFEST.SKIP may contain regular expressions of files that
444 should be ignored by mkmanifest() and filecheck(). The regular
445 expressions should appear one on each line. Blank lines and lines
446 which start with C<#> are skipped. Use C<\#> if you need a regular
447 expression to start with a sharp character. A typical example:
449 # Version control files and dirs.
454 # Makemaker generated files and dirs.
460 # Temp, old and emacs backup files.
466 If no MANIFEST.SKIP file is found, a default set of skips will be
467 used, similar to the example above. If you want nothing skipped,
468 simply make an empty MANIFEST.SKIP file.
473 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
474 C<&maniread>, and C<&manicopy> are exportable.
476 =head1 GLOBAL VARIABLES
478 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
479 results in both a different C<MANIFEST> and a different
480 C<MANIFEST.SKIP> file. This is useful if you want to maintain
481 different distributions for different audiences (say a user version
482 and a developer version including RCS).
484 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
485 all functions act silently.
487 C<$ExtUtils::Manifest::Debug> defaults to 0. If set to a true value,
488 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
493 All diagnostic output is sent to C<STDERR>.
497 =item C<Not in MANIFEST:> I<file>
499 is reported if a file is found, that is missing in the C<MANIFEST>
500 file which is excluded by a regular expression in the file
503 =item C<No such file:> I<file>
505 is reported if a file mentioned in a C<MANIFEST> file does not
508 =item C<MANIFEST:> I<$!>
510 is reported if C<MANIFEST> could not be opened.
512 =item C<Added to MANIFEST:> I<file>
514 is reported by mkmanifest() if $Verbose is set and a file is added
515 to MANIFEST. $Verbose is set to 1 by default.
523 =item B<PERL_MM_MANIFEST_DEBUG>
531 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
535 Andreas Koenig <F<andreas.koenig@anima.de>>