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