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