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