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