Memoize tests
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Manifest.pm
CommitLineData
005c1a0e 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 9use strict;
10
f168a5e7 11our ($VERSION,@ISA,@EXPORT_OK,
5d31cce8 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 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 30# Really cool fix from Ilya :)
31unless (defined $Config{d_link}) {
db376a24 32 no warnings;
4e68a208 33 *ln = \&cp;
34}
35
005c1a0e 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 41 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
42 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
005c1a0e 43 my $matches = _maniskip();
44 my $found = manifind();
45 my($key,$val,$file,%all);
f1387719 46 %all = (%$found, %$read);
84876ac5 47 $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
48 if $manimiss; # add new MANIFEST to known file list
005c1a0e 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 57 my $tabs = (5 - (length($file)+1)/8);
58 $tabs = 1 if $tabs < 1;
8e07c86e 59 $tabs = 0 unless $text;
60 print M $file, "\t" x $tabs, $text, "\n";
005c1a0e 61 }
62 close M;
63}
64
65sub manifind {
66 local $found = {};
4633a7c4 67 find(sub {return if -d $_;
db5fd395 68 (my $name = $File::Find::name) =~ s|^\./||;
69 $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
005c1a0e 70 warn "Debug: diskfile $name\n" if $Debug;
db5fd395 71 $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
72 $found->{$name} = "";}, $Is_MacOS ? ":" : ".");
005c1a0e 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 88sub skipcheck {
89 _manicheck(6);
90}
91
005c1a0e 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 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 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 108 warn "No such file: $file\n" unless $Quiet;
109 push @missfile, $file;
005c1a0e 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 118 if (&$matches($file)){
119 warn "Skipping $file\n" if $skipwarn;
120 next;
121 }
005c1a0e 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 127 }
128 }
129 }
130 (\@missfile,\@missentry);
131}
132
133sub maniread {
134 my ($mfile) = @_;
15a074ca 135 $mfile ||= $MANIFEST;
005c1a0e 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 145
146 my($file, $comment) = /^(\S+)\s*(.*)/;
147 next unless $file;
148
db5fd395 149 if ($Is_MacOS) {
0e3309e2 150 $file = _macify($file);
151 $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
db5fd395 152 }
153 elsif ($Is_VMS) {
9607fc9c 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 163
164 $read->{$file} = $comment;
005c1a0e 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 178 while (<M>){
179 chomp;
15a074ca 180 next if /^#/;
005c1a0e 181 next if /^\s*$/;
db5fd395 182 push @skip, _macify($_);
005c1a0e 183 }
184 close M;
8e07c86e 185 my $opts = $Is_VMS ? 'oi ' : 'o ';
005c1a0e 186 my $sub = "\$matches = "
187 . "sub { my(\$arg)=\@_; return 1 if "
8e07c86e 188 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
005c1a0e 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 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 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 221 }
222}
223
224sub cp_if_diff {
8a1da95f 225 my($from, $to, $how)=@_;
15a074ca 226 -f $from or carp "$0: $from not found";
8e07c86e 227 my($diff) = 0;
228 local(*F,*T);
db5fd395 229 open(F,"< $from\0") or croak "Can't read $from: $!\n";
230 if (open(T,"< $to\0")) {
8e07c86e 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 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 249 }
250}
251
8e07c86e 252sub cp {
253 my ($srcFile, $dstFile) = @_;
79dd614e 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 259}
260
261sub ln {
262 my ($srcFile, $dstFile) = @_;
f0f13d0e 263 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
8e07c86e 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 267 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
268 unlink $dstFile;
269 return;
270 }
271 1;
8e07c86e 272}
273
4633a7c4 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 280 }
281}
282
db5fd395 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 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 346
347=head1 DESCRIPTION
348
d962e1c0 349mkmanifest() writes all files in and below the current directory to a
79dd614e 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 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 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 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 376C<MANIFEST.SKIP> file.
377
d962e1c0 378manifind() returns a hash reference. The keys of the hash are the
79dd614e 379files found below the current directory.
380
d962e1c0 381maniread($file) reads a named C<MANIFEST> file (defaults to
79dd614e 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 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 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 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 407 \bCVS\b
408 ,v$
409
410 # Makemaker generated files and dirs.
79dd614e 411 ^MANIFEST\.
412 ^Makefile$
79dd614e 413 ^blib/
414 ^MakeMaker-\d
415
0b9c804f 416 # Temp, old and emacs backup files.
417 ~$
418 \.old$
419 ^#.*#$
cfcce72b 420 ^\.#
0b9c804f 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 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 441all functions act silently.
442
0b9c804f 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 447=head1 DIAGNOSTICS
448
449All diagnostic output is sent to C<STDERR>.
450
bbc7dcd2 451=over 4
79dd614e 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 475=head1 ENVIRONMENT
476
477=over 4
478
479=item B<PERL_MM_MANIFEST_DEBUG>
480
481Turns on debugging
482
483=back
484
79dd614e 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 492
493=cut