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