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