This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1n for perl5.001.
[perl5.git] / lib / ExtUtils / Manifest.pm
CommitLineData
005c1a0e
AD
1package ExtUtils::Manifest;
2
3=head1 NAME
4
5ExtUtils::Manifest - utilities to write and check a MANIFEST file
6
7=head1 SYNOPSIS
8
9C<require ExtUtils::Manifest;>
10
11C<ExtUtils::Manifest::mkmanifest;>
12
13C<ExtUtils::Manifest::manicheck;>
14
15C<ExtUtils::Manifest::filecheck;>
16
17C<ExtUtils::Manifest::fullcheck;>
18
19C<ExtUtils::Manifest::maniread($file);>
20
8e07c86e 21C<ExtUtils::Manifest::manicopy($read,$target,$how);>
005c1a0e
AD
22
23=head1 DESCRIPTION
24
25Mkmanifest() writes all files in and below the current directory to a
26file named C<MANIFEST> in the current directory. It works similar to
27
28 find . -print
29
30but in doing so checks each line in an existing C<MANIFEST> file and
31includes any comments that are found in the existing C<MANIFEST> file
32in the new one. Anything between white space and an end of line within
33a C<MANIFEST> file is considered to be a comment. Filenames and
34comments are seperated by one or more TAB characters in the
35output. All files that match any regular expression in a file
36C<MANIFEST.SKIP> (if such a file exists) are ignored.
37
38Manicheck() checks if all the files within a C<MANIFEST> in the current
39directory really do exist.
40
41Filecheck() finds files below the current directory that are not
42mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
43will be consulted. Any file matching a regular expression in such a
44file will not be reported as missing in the C<MANIFEST> file.
45
46Fullcheck() does both a manicheck() and a filecheck().
47
48Maniread($file) reads a named C<MANIFEST> file (defaults to
49C<MANIFEST> in the current directory) and returns a HASH reference
50with files being the keys and comments being the values of the HASH.
51
8e07c86e
AD
52I<Manicopy($read,$target,$how)> copies the files that are the keys in
53the HASH I<%$read> to the named target directory. The HASH reference
005c1a0e
AD
54I<$read> is typically returned by the maniread() function. This
55function is useful for producing a directory tree identical to the
8e07c86e
AD
56intended distribution tree. The third parameter $how can be used to
57specify a different system call to do the copying (eg. C<ln> instead
58of C<cp>, which is the default).
005c1a0e
AD
59
60=head1 MANIFEST.SKIP
61
62The file MANIFEST.SKIP may contain regular expressions of files that
63should be ignored by mkmanifest() and filecheck(). The regular
64expressions should appear one on each line. A typical example:
65
66 \bRCS\b
67 ^MANIFEST\.
68 ^Makefile$
69 ~$
70 \.html$
71 \.old$
72 ^blib/
73 ^MakeMaker-\d
74
75=head1 EXPORT_OK
76
77C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
78C<&maniread>, and C<&manicopy> are exportable.
79
80=head1 DIAGNOSTICS
81
82All diagnostic output is sent to C<STDERR>.
83
84=over
8e07c86e 85
005c1a0e 86=item C<Not in MANIFEST:> I<file>
8e07c86e 87
005c1a0e
AD
88is reported if a file is found, that is missing in the C<MANIFEST>
89file which is excluded by a regular expression in the file
90C<MANIFEST.SKIP>.
91
92=item C<No such file:> I<file>
8e07c86e 93
005c1a0e
AD
94is reported if a file mentioned in a C<MANIFEST> file does not
95exist.
96
97=item C<MANIFEST:> I<$!>
8e07c86e 98
005c1a0e
AD
99is reported if C<MANIFEST> could not be opened.
100
101=item C<Added to MANIFEST:> I<file>
8e07c86e 102
005c1a0e
AD
103is reported by mkmanifest() if $Verbose is set and a file is added
104to MANIFEST. $Verbose is set to 1 by default.
105
106=back
107
108=head1 AUTHOR
109
110Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
111
112=cut
113
114require Exporter;
115@ISA=('Exporter');
116@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
8e07c86e 117 'skipcheck', 'maniread', 'manicopy');
005c1a0e 118
8e07c86e 119use Config;
005c1a0e
AD
120use File::Find;
121use Carp;
122
123$Debug = 0;
124$Verbose = 1;
8e07c86e 125$Is_VMS = $Config{'osname'} eq 'VMS';
005c1a0e 126
8e07c86e 127($Version) = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
005c1a0e
AD
128$Version = $Version; #avoid warning
129
130$Quiet = 0;
131
132sub mkmanifest {
133 my $manimiss = 0;
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);
140 local *M;
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);
145 if ($Verbose){
146 warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
147 }
8e07c86e
AD
148 my $text = $all{$file};
149 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS;
005c1a0e
AD
150 my $tabs = (5 - (length($file)+1)/8);
151 $tabs = 1 if $tabs < 1;
8e07c86e
AD
152 $tabs = 0 unless $text;
153 print M $file, "\t" x $tabs, $text, "\n";
005c1a0e
AD
154 }
155 close M;
156}
157
158sub manifind {
159 local $found = {};
8e07c86e 160 find(sub {return if -d $File::Find::name;
005c1a0e
AD
161 (my $name = $File::Find::name) =~ s|./||;
162 warn "Debug: diskfile $name\n" if $Debug;
8e07c86e 163 $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
005c1a0e
AD
164 $found->{$name} = "";}, ".");
165 $found;
166}
167
168sub fullcheck {
169 _manicheck(3);
170}
171
172sub manicheck {
173 return @{(_manicheck(1))[0]};
174}
175
176sub filecheck {
177 return @{(_manicheck(2))[1]};
178}
179
8e07c86e
AD
180sub skipcheck {
181 _manicheck(6);
182}
183
005c1a0e
AD
184sub _manicheck {
185 my($arg) = @_;
186 my $read = maniread();
187 my $file;
188 my(@missfile,@missentry);
189 if ($arg & 1){
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} ) {
8e07c86e
AD
194 warn "No such file: $file\n" unless $Quiet;
195 push @missfile, $file;
005c1a0e
AD
196 }
197 }
198 }
199 if ($arg & 2){
200 $read ||= {};
201 my $matches = _maniskip();
202 my $found = manifind();
8e07c86e 203 my $skipwarn = $arg & 4;
005c1a0e 204 foreach $file (sort keys %$found){
8e07c86e
AD
205 if (&$matches($file)){
206 warn "Skipping $file\n" if $skipwarn;
207 next;
208 }
005c1a0e
AD
209 warn "Debug: manicheck checking from disk $file\n" if $Debug;
210 unless ( exists $read->{$file} ) {
8e07c86e
AD
211 warn "Not in MANIFEST: $file\n" unless $Quiet;
212 push @missentry, $file;
005c1a0e
AD
213 }
214 }
215 }
216 (\@missfile,\@missentry);
217}
218
219sub maniread {
220 my ($mfile) = @_;
221 $mfile = "MANIFEST" unless defined $mfile;
222 my $read = {};
223 local *M;
224 unless (open M, $mfile){
225 warn "$mfile: $!";
226 return $read;
227 }
228 while (<M>){
229 chomp;
8e07c86e
AD
230 if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
231 else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
005c1a0e
AD
232 }
233 close M;
234 $read;
235}
236
237# returns an anonymous sub that decides if an argument matches
238sub _maniskip {
239 my ($mfile) = @_;
240 my $matches = sub {0};
241 my @skip ;
242 my $mfile = "MANIFEST.SKIP" unless defined $mfile;
243 local *M;
244 return $matches unless -f $mfile;
245 open M, $mfile or return $matches;
246 while (<M>){
247 chomp;
248 next if /^\s*$/;
249 push @skip, $_;
250 }
251 close M;
8e07c86e 252 my $opts = $Is_VMS ? 'oi ' : 'o ';
005c1a0e
AD
253 my $sub = "\$matches = "
254 . "sub { my(\$arg)=\@_; return 1 if "
8e07c86e 255 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
005c1a0e
AD
256 . " }";
257 eval $sub;
258 print "Debug: $sub\n" if $Debug;
259 $matches;
260}
261
262sub manicopy {
8e07c86e 263 my($read,$target,$how)=@_;
005c1a0e 264 croak "manicopy() called without target argument" unless defined $target;
8e07c86e 265 $how = 'cp' unless defined $how && $how;
005c1a0e
AD
266 require File::Path;
267 require File::Basename;
268 my(%dirs,$file);
8e07c86e
AD
269 $target = VMS::Filespec::unixify($target) if $Is_VMS;
270 umask 0;
005c1a0e 271 foreach $file (keys %$read){
8e07c86e 272 $file = VMS::Filespec::unixify($file) if $Is_VMS;
005c1a0e 273 my $dir = File::Basename::dirname($file);
8e07c86e
AD
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); }
005c1a0e
AD
277 }
278}
279
280sub cp_if_diff {
8e07c86e 281 my($from,$to, $how)=@_;
005c1a0e 282 -f $from || carp "$0: $from not found";
8e07c86e
AD
283 my($diff) = 0;
284 local(*F,*T);
285 open(F,$from) or croak "Can't read $from: $!\n";
286 if (open(T,$to)) {
287 while (<F>) { $diff++,last if $_ ne <T>; }
288 $diff++ unless eof(T);
289 close T;
290 }
291 else { $diff++; }
292 close F;
293 if ($diff) {
294 if (-e $to) {
295 unlink($to) or confess "unlink $to: $!";
296 }
297 &$how($from, $to);
298 }
299}
300
301# Do the comparisons here rather than spawning off another process
302sub vms_cp_if_diff {
303 my($from,$to) = @_;
304 my($diff) = 0;
305 local(*F,*T);
306 open(F,$from) or croak "Can't read $from: $!\n";
307 if (open(T,$to)) {
308 while (<F>) { $diff++,last if $_ ne <T>; }
309 $diff++ unless eof(T);
310 close T;
311 }
312 else { $diff++; }
313 close F;
314 if ($diff) {
315 system('copy',vmsify($from),vmsify($to)) & 1
316 or confess "Copy failed: $!";
005c1a0e
AD
317 }
318}
319
8e07c86e
AD
320sub cp {
321 my ($srcFile, $dstFile) = @_;
322 my $buf;
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);
327 close IN;
328 close OUT;
329 utime $access, $mod, $dstFile;
330 # chmod a+rX-w,go-w
331 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile );
332}
333
334sub ln {
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 ), $_ );
340}
341
005c1a0e 3421;