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