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