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