This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skipping CVS conflict backup files
[perl5.git] / lib / ExtUtils / Manifest.pm
1 package ExtUtils::Manifest;
2
3 require Exporter;
4 use Config;
5 use File::Find;
6 use File::Copy 'copy';
7 use File::Spec::Functions qw(splitpath);
8 use Carp;
9 use strict;
10
11 our ($VERSION,@ISA,@EXPORT_OK,
12             $Is_VMS,$Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP);
13
14 $VERSION = substr(q$Revision: 1.33 $, 10);
15 @ISA=('Exporter');
16 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
17               'skipcheck', 'maniread', 'manicopy');
18
19 $Is_VMS = $^O eq 'VMS';
20 if ($Is_VMS) { require File::Basename }
21
22 $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
23 $Verbose = 1;
24 $Quiet = 0;
25 $MANIFEST = 'MANIFEST';
26 $DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";
27
28 # Really cool fix from Ilya :)
29 unless (defined $Config{d_link}) {
30     no warnings;
31     *ln = \&cp;
32 }
33
34 sub mkmanifest {
35     my $manimiss = 0;
36     my $read = maniread() or $manimiss++;
37     $read = {} if $manimiss;
38     local *M;
39     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
40     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
41     my $matches = _maniskip();
42     my $found = manifind();
43     my($key,$val,$file,%all);
44     %all = (%$found, %$read);
45     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
46         if $manimiss; # add new MANIFEST to known file list
47     foreach $file (sort keys %all) {
48         next if &$matches($file);
49         if ($Verbose){
50             warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
51         }
52         my $text = $all{$file};
53         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
54         my $tabs = (5 - (length($file)+1)/8);
55         $tabs = 1 if $tabs < 1;
56         $tabs = 0 unless $text;
57         print M $file, "\t" x $tabs, $text, "\n";
58     }
59     close M;
60 }
61
62 sub manifind {
63     local $found = {};
64     find(sub {return if -d $_;
65               (my $name = $File::Find::name) =~ s|./||;
66               warn "Debug: diskfile $name\n" if $Debug;
67               $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
68               $found->{$name} = "";}, ".");
69     $found;
70 }
71
72 sub fullcheck {
73     _manicheck(3);
74 }
75
76 sub manicheck {
77     return @{(_manicheck(1))[0]};
78 }
79
80 sub filecheck {
81     return @{(_manicheck(2))[1]};
82 }
83
84 sub skipcheck {
85     _manicheck(6);
86 }
87
88 sub _manicheck {
89     my($arg) = @_;
90     my $read = maniread();
91     my $found = manifind();
92     my $file;
93     my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
94     my(@missfile,@missentry);
95     if ($arg & 1){
96         foreach $file (sort keys %$read){
97             warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
98             if ($dosnames){
99                 $file = lc $file;
100                 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
101                 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
102             }
103             unless ( exists $found->{$file} ) {
104                 warn "No such file: $file\n" unless $Quiet;
105                 push @missfile, $file;
106             }
107         }
108     }
109     if ($arg & 2){
110         $read ||= {};
111         my $matches = _maniskip();
112         my $skipwarn = $arg & 4;
113         foreach $file (sort keys %$found){
114             if (&$matches($file)){
115                 warn "Skipping $file\n" if $skipwarn;
116                 next;
117             }
118             warn "Debug: manicheck checking from disk $file\n" if $Debug;
119             unless ( exists $read->{$file} ) {
120                 warn "Not in $MANIFEST: $file\n" unless $Quiet;
121                 push @missentry, $file;
122             }
123         }
124     }
125     (\@missfile,\@missentry);
126 }
127
128 sub maniread {
129     my ($mfile) = @_;
130     $mfile ||= $MANIFEST;
131     my $read = {};
132     local *M;
133     unless (open M, $mfile){
134         warn "$mfile: $!";
135         return $read;
136     }
137     while (<M>){
138         chomp;
139         next if /^#/;
140         if ($Is_VMS) {
141             my($file)= /^(\S+)/;
142             next unless $file;
143             my($base,$dir) = File::Basename::fileparse($file);
144             # Resolve illegal file specifications in the same way as tar
145             $dir =~ tr/./_/;
146             my(@pieces) = split(/\./,$base);
147             if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
148             my $okfile = "$dir$base";
149             warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
150             $read->{"\L$okfile"}=$_;
151         }
152         else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
153     }
154     close M;
155     $read;
156 }
157
158 # returns an anonymous sub that decides if an argument matches
159 sub _maniskip {
160     my ($mfile) = @_;
161     my $matches = sub {0};
162     my @skip ;
163     $mfile ||= "$MANIFEST.SKIP";
164     local *M;
165     open M, $mfile or open M, $DEFAULT_MSKIP or return $matches;
166     while (<M>){
167         chomp;
168         next if /^#/;
169         next if /^\s*$/;
170         push @skip, $_;
171     }
172     close M;
173     my $opts = $Is_VMS ? 'oi ' : 'o ';
174     my $sub = "\$matches = "
175         . "sub { my(\$arg)=\@_; return 1 if "
176         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
177         . " }";
178     eval $sub;
179     print "Debug: $sub\n" if $Debug;
180     $matches;
181 }
182
183 sub manicopy {
184     my($read,$target,$how)=@_;
185     croak "manicopy() called without target argument" unless defined $target;
186     $how ||= 'cp';
187     require File::Path;
188     require File::Basename;
189     my(%dirs,$file);
190     $target = VMS::Filespec::unixify($target) if $Is_VMS;
191     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
192     foreach $file (keys %$read){
193         $file = VMS::Filespec::unixify($file) if $Is_VMS;
194         if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
195             my $dir = File::Basename::dirname($file);
196             $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
197             File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
198         }
199         cp_if_diff($file, "$target/$file", $how);
200     }
201 }
202
203 sub cp_if_diff {
204     my($from, $to, $how)=@_;
205     -f $from or carp "$0: $from not found";
206     my($diff) = 0;
207     local(*F,*T);
208     open(F,$from) or croak "Can't read $from: $!\n";
209     if (open(T,$to)) {
210         while (<F>) { $diff++,last if $_ ne <T>; }
211         $diff++ unless eof(T);
212         close T;
213     }
214     else { $diff++; }
215     close F;
216     if ($diff) {
217         if (-e $to) {
218             unlink($to) or confess "unlink $to: $!";
219         }
220       STRICT_SWITCH: {
221             best($from,$to), last STRICT_SWITCH if $how eq 'best';
222             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
223             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
224             croak("ExtUtils::Manifest::cp_if_diff " .
225                   "called with illegal how argument [$how]. " .
226                   "Legal values are 'best', 'cp', and 'ln'.");
227         }
228     }
229 }
230
231 sub cp {
232     my ($srcFile, $dstFile) = @_;
233     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
234     copy($srcFile,$dstFile);
235     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
236     # chmod a+rX-w,go-w
237     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
238 }
239
240 sub ln {
241     my ($srcFile, $dstFile) = @_;
242     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
243     link($srcFile, $dstFile);
244     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
245     my $mode= 0444 | (stat)[2] & 0700;
246     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
247        unlink $dstFile;
248        return;
249     }
250     1;
251 }
252
253 sub best {
254     my ($srcFile, $dstFile) = @_;
255     if (-l $srcFile) {
256         cp($srcFile, $dstFile);
257     } else {
258         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
259     }
260 }
261
262 1;
263
264 __END__
265
266 =head1 NAME
267
268 ExtUtils::Manifest - utilities to write and check a MANIFEST file
269
270 =head1 SYNOPSIS
271
272     require ExtUtils::Manifest;
273
274     ExtUtils::Manifest::mkmanifest;
275
276     ExtUtils::Manifest::manicheck;
277
278     ExtUtils::Manifest::filecheck;
279
280     ExtUtils::Manifest::fullcheck;
281
282     ExtUtils::Manifest::skipcheck;
283
284     ExtUtils::Manifest::manifind();
285
286     ExtUtils::Manifest::maniread($file);
287
288     ExtUtils::Manifest::manicopy($read,$target,$how);
289
290 =head1 DESCRIPTION
291
292 mkmanifest() writes all files in and below the current directory to a
293 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
294 defaults to C<MANIFEST>) in the current directory. It works similar to
295
296     find . -print
297
298 but in doing so checks each line in an existing C<MANIFEST> file and
299 includes any comments that are found in the existing C<MANIFEST> file
300 in the new one. Anything between white space and an end of line within
301 a C<MANIFEST> file is considered to be a comment. Filenames and
302 comments are separated by one or more TAB characters in the
303 output. All files that match any regular expression in a file
304 C<MANIFEST.SKIP> (if such a file exists) are ignored.
305
306 manicheck() checks if all the files within a C<MANIFEST> in the
307 current directory really do exist. It only reports discrepancies and
308 exits silently if MANIFEST and the tree below the current directory
309 are in sync.
310
311 filecheck() finds files below the current directory that are not
312 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
313 will be consulted. Any file matching a regular expression in such a
314 file will not be reported as missing in the C<MANIFEST> file.
315
316 fullcheck() does both a manicheck() and a filecheck().
317
318 skipcheck() lists all the files that are skipped due to your
319 C<MANIFEST.SKIP> file.
320
321 manifind() returns a hash reference. The keys of the hash are the
322 files found below the current directory.
323
324 maniread($file) reads a named C<MANIFEST> file (defaults to
325 C<MANIFEST> in the current directory) and returns a HASH reference
326 with files being the keys and comments being the values of the HASH.
327 Blank lines and lines which start with C<#> in the C<MANIFEST> file
328 are discarded.
329
330 C<manicopy($read,$target,$how)> copies the files that are the keys in
331 the HASH I<%$read> to the named target directory. The HASH reference
332 $read is typically returned by the maniread() function. This
333 function is useful for producing a directory tree identical to the
334 intended distribution tree. The third parameter $how can be used to
335 specify a different methods of "copying". Valid values are C<cp>,
336 which actually copies the files, C<ln> which creates hard links, and
337 C<best> which mostly links the files but copies any symbolic link to
338 make a tree without any symbolic link. Best is the default.
339
340 =head1 MANIFEST.SKIP
341
342 The file MANIFEST.SKIP may contain regular expressions of files that
343 should be ignored by mkmanifest() and filecheck(). The regular
344 expressions should appear one on each line. Blank lines and lines
345 which start with C<#> are skipped.  Use C<\#> if you need a regular
346 expression to start with a sharp character. A typical example:
347
348     # Version control files and dirs.
349     \bRCS\b
350     \bCVS\b
351     ,v$
352
353     # Makemaker generated files and dirs.
354     ^MANIFEST\.
355     ^Makefile$
356     ^blib/
357     ^MakeMaker-\d
358
359     # Temp, old and emacs backup files.
360     ~$
361     \.old$
362     ^#.*#$
363     ^\.#
364
365 If no MANIFEST.SKIP file is found, a default set of skips will be
366 used, similar to the example above.  If you want nothing skipped,
367 simply make an empty MANIFEST.SKIP file.
368
369
370 =head1 EXPORT_OK
371
372 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
373 C<&maniread>, and C<&manicopy> are exportable.
374
375 =head1 GLOBAL VARIABLES
376
377 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
378 results in both a different C<MANIFEST> and a different
379 C<MANIFEST.SKIP> file. This is useful if you want to maintain
380 different distributions for different audiences (say a user version
381 and a developer version including RCS).
382
383 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
384 all functions act silently.
385
386 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
387 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
388 produced.
389
390 =head1 DIAGNOSTICS
391
392 All diagnostic output is sent to C<STDERR>.
393
394 =over
395
396 =item C<Not in MANIFEST:> I<file>
397
398 is reported if a file is found, that is missing in the C<MANIFEST>
399 file which is excluded by a regular expression in the file
400 C<MANIFEST.SKIP>.
401
402 =item C<No such file:> I<file>
403
404 is reported if a file mentioned in a C<MANIFEST> file does not
405 exist.
406
407 =item C<MANIFEST:> I<$!>
408
409 is reported if C<MANIFEST> could not be opened.
410
411 =item C<Added to MANIFEST:> I<file>
412
413 is reported by mkmanifest() if $Verbose is set and a file is added
414 to MANIFEST. $Verbose is set to 1 by default.
415
416 =back
417
418 =head1 ENVIRONMENT
419
420 =over 4
421
422 =item B<PERL_MM_MANIFEST_DEBUG>
423
424 Turns on debugging
425
426 =back
427
428 =head1 SEE ALSO
429
430 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
431
432 =head1 AUTHOR
433
434 Andreas Koenig <F<andreas.koenig@anima.de>>
435
436 =cut