1 package ExtUtils::Manifest;
5 ExtUtils::Manifest - utilities to write and check a MANIFEST file
9 C<require ExtUtils::Manifest;>
11 C<ExtUtils::Manifest::mkmanifest;>
13 C<ExtUtils::Manifest::manicheck;>
15 C<ExtUtils::Manifest::filecheck;>
17 C<ExtUtils::Manifest::fullcheck;>
19 C<ExtUtils::Manifest::maniread($file);>
21 C<ExtUtils::Manifest::manicopy($read,$target,$how);>
25 Mkmanifest() writes all files in and below the current directory to a
26 file named C<MANIFEST> in the current directory. It works similar to
30 but in doing so checks each line in an existing C<MANIFEST> file and
31 includes any comments that are found in the existing C<MANIFEST> file
32 in the new one. Anything between white space and an end of line within
33 a C<MANIFEST> file is considered to be a comment. Filenames and
34 comments are seperated by one or more TAB characters in the
35 output. All files that match any regular expression in a file
36 C<MANIFEST.SKIP> (if such a file exists) are ignored.
38 Manicheck() checks if all the files within a C<MANIFEST> in the current
39 directory really do exist.
41 Filecheck() finds files below the current directory that are not
42 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
43 will be consulted. Any file matching a regular expression in such a
44 file will not be reported as missing in the C<MANIFEST> file.
46 Fullcheck() does both a manicheck() and a filecheck().
48 Maniread($file) reads a named C<MANIFEST> file (defaults to
49 C<MANIFEST> in the current directory) and returns a HASH reference
50 with files being the keys and comments being the values of the HASH.
52 I<Manicopy($read,$target,$how)> copies the files that are the keys in
53 the HASH I<%$read> to the named target directory. The HASH reference
54 I<$read> is typically returned by the maniread() function. This
55 function is useful for producing a directory tree identical to the
56 intended distribution tree. The third parameter $how can be used to
57 specify a different system call to do the copying (eg. C<ln> instead
58 of C<cp>, which is the default).
62 The file MANIFEST.SKIP may contain regular expressions of files that
63 should be ignored by mkmanifest() and filecheck(). The regular
64 expressions should appear one on each line. A typical example:
77 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
78 C<&maniread>, and C<&manicopy> are exportable.
82 All diagnostic output is sent to C<STDERR>.
86 =item C<Not in MANIFEST:> I<file>
88 is reported if a file is found, that is missing in the C<MANIFEST>
89 file which is excluded by a regular expression in the file
92 =item C<No such file:> I<file>
94 is reported if a file mentioned in a C<MANIFEST> file does not
97 =item C<MANIFEST:> I<$!>
99 is reported if C<MANIFEST> could not be opened.
101 =item C<Added to MANIFEST:> I<file>
103 is reported by mkmanifest() if $Verbose is set and a file is added
104 to MANIFEST. $Verbose is set to 1 by default.
110 Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
116 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
117 'skipcheck', 'maniread', 'manicopy');
125 $Is_VMS = $Config{'osname'} eq 'VMS';
127 ($Version) = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
128 $Version = $Version; #avoid warning
134 my $read = maniread() or $manimiss++;
135 $read = {} if $manimiss;
136 my $matches = _maniskip();
137 my $found = manifind();
138 my($key,$val,$file,%all);
139 my %all = (%$found, %$read);
141 rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
142 open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
143 foreach $file (sort keys %all) {
144 next if &$matches($file);
146 warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
148 my $text = $all{$file};
149 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS;
150 my $tabs = (5 - (length($file)+1)/8);
151 $tabs = 1 if $tabs < 1;
152 $tabs = 0 unless $text;
153 print M $file, "\t" x $tabs, $text, "\n";
160 find(sub {return if -d $File::Find::name;
161 (my $name = $File::Find::name) =~ s|./||;
162 warn "Debug: diskfile $name\n" if $Debug;
163 $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
164 $found->{$name} = "";}, ".");
173 return @{(_manicheck(1))[0]};
177 return @{(_manicheck(2))[1]};
186 my $read = maniread();
188 my(@missfile,@missentry);
190 my $found = manifind();
191 foreach $file (sort keys %$read){
192 warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
193 unless ( exists $found->{$file} ) {
194 warn "No such file: $file\n" unless $Quiet;
195 push @missfile, $file;
201 my $matches = _maniskip();
202 my $found = manifind();
203 my $skipwarn = $arg & 4;
204 foreach $file (sort keys %$found){
205 if (&$matches($file)){
206 warn "Skipping $file\n" if $skipwarn;
209 warn "Debug: manicheck checking from disk $file\n" if $Debug;
210 unless ( exists $read->{$file} ) {
211 warn "Not in MANIFEST: $file\n" unless $Quiet;
212 push @missentry, $file;
216 (\@missfile,\@missentry);
221 $mfile = "MANIFEST" unless defined $mfile;
224 unless (open M, $mfile){
230 if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
231 else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
237 # returns an anonymous sub that decides if an argument matches
240 my $matches = sub {0};
242 my $mfile = "MANIFEST.SKIP" unless defined $mfile;
244 return $matches unless -f $mfile;
245 open M, $mfile or return $matches;
252 my $opts = $Is_VMS ? 'oi ' : 'o ';
253 my $sub = "\$matches = "
254 . "sub { my(\$arg)=\@_; return 1 if "
255 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
258 print "Debug: $sub\n" if $Debug;
263 my($read,$target,$how)=@_;
264 croak "manicopy() called without target argument" unless defined $target;
265 $how = 'cp' unless defined $how && $how;
267 require File::Basename;
269 $target = VMS::Filespec::unixify($target) if $Is_VMS;
271 foreach $file (keys %$read){
272 $file = VMS::Filespec::unixify($file) if $Is_VMS;
273 my $dir = File::Basename::dirname($file);
274 File::Path::mkpath(["$target/$dir"],1,0755);
275 if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
276 else { cp_if_diff($file, "$target/$file", $how); }
281 my($from,$to, $how)=@_;
282 -f $from || carp "$0: $from not found";
285 open(F,$from) or croak "Can't read $from: $!\n";
287 while (<F>) { $diff++,last if $_ ne <T>; }
288 $diff++ unless eof(T);
295 unlink($to) or confess "unlink $to: $!";
301 # Do the comparisons here rather than spawning off another process
306 open(F,$from) or croak "Can't read $from: $!\n";
308 while (<F>) { $diff++,last if $_ ne <T>; }
309 $diff++ unless eof(T);
315 system('copy',vmsify($from),vmsify($to)) & 1
316 or confess "Copy failed: $!";
321 my ($srcFile, $dstFile) = @_;
323 open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n";
324 open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n";
325 my ($perm,$access,$mod) = (stat IN)[2,8,9];
326 syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192);
329 utime $access, $mod, $dstFile;
331 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile );
335 my ($srcFile, $dstFile) = @_;
336 link($srcFile, $dstFile);
337 local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
338 my $mode= 0444 | (stat)[2] & 0700;
339 chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ );