fix diagnostics to report "our" vs "my" correctly
[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}) {
d962e1c0 28 local $^W;
4e68a208 29 *ln = \&cp;
30}
31
005c1a0e 32sub mkmanifest {
33 my $manimiss = 0;
34 my $read = maniread() or $manimiss++;
35 $read = {} if $manimiss;
864a5fa8 36 local *M;
cb1a09d0 37 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
38 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
005c1a0e 39 my $matches = _maniskip();
40 my $found = manifind();
41 my($key,$val,$file,%all);
f1387719 42 %all = (%$found, %$read);
84876ac5 43 $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
44 if $manimiss; # add new MANIFEST to known file list
005c1a0e 45 foreach $file (sort keys %all) {
46 next if &$matches($file);
47 if ($Verbose){
cb1a09d0 48 warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
005c1a0e 49 }
8e07c86e 50 my $text = $all{$file};
84876ac5 51 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
005c1a0e 52 my $tabs = (5 - (length($file)+1)/8);
53 $tabs = 1 if $tabs < 1;
8e07c86e 54 $tabs = 0 unless $text;
55 print M $file, "\t" x $tabs, $text, "\n";
005c1a0e 56 }
57 close M;
58}
59
60sub manifind {
61 local $found = {};
4633a7c4 62 find(sub {return if -d $_;
005c1a0e 63 (my $name = $File::Find::name) =~ s|./||;
64 warn "Debug: diskfile $name\n" if $Debug;
8e07c86e 65 $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
005c1a0e 66 $found->{$name} = "";}, ".");
67 $found;
68}
69
70sub fullcheck {
71 _manicheck(3);
72}
73
74sub manicheck {
75 return @{(_manicheck(1))[0]};
76}
77
78sub filecheck {
79 return @{(_manicheck(2))[1]};
80}
81
8e07c86e 82sub skipcheck {
83 _manicheck(6);
84}
85
005c1a0e 86sub _manicheck {
87 my($arg) = @_;
88 my $read = maniread();
15a074ca 89 my $found = manifind();
005c1a0e 90 my $file;
39e571d4 91 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
005c1a0e 92 my(@missfile,@missentry);
93 if ($arg & 1){
005c1a0e 94 foreach $file (sort keys %$read){
cb1a09d0 95 warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
39e571d4 96 if ($dosnames){
97 $file = lc $file;
98 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
99 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
100 }
005c1a0e 101 unless ( exists $found->{$file} ) {
8e07c86e 102 warn "No such file: $file\n" unless $Quiet;
103 push @missfile, $file;
005c1a0e 104 }
105 }
106 }
107 if ($arg & 2){
108 $read ||= {};
109 my $matches = _maniskip();
8e07c86e 110 my $skipwarn = $arg & 4;
005c1a0e 111 foreach $file (sort keys %$found){
8e07c86e 112 if (&$matches($file)){
113 warn "Skipping $file\n" if $skipwarn;
114 next;
115 }
005c1a0e 116 warn "Debug: manicheck checking from disk $file\n" if $Debug;
117 unless ( exists $read->{$file} ) {
cb1a09d0 118 warn "Not in $MANIFEST: $file\n" unless $Quiet;
8e07c86e 119 push @missentry, $file;
005c1a0e 120 }
121 }
122 }
123 (\@missfile,\@missentry);
124}
125
126sub maniread {
127 my ($mfile) = @_;
15a074ca 128 $mfile ||= $MANIFEST;
005c1a0e 129 my $read = {};
130 local *M;
131 unless (open M, $mfile){
132 warn "$mfile: $!";
133 return $read;
134 }
135 while (<M>){
136 chomp;
15a074ca 137 next if /^#/;
9607fc9c 138 if ($Is_VMS) {
139 my($file)= /^(\S+)/;
140 next unless $file;
141 my($base,$dir) = File::Basename::fileparse($file);
142 # Resolve illegal file specifications in the same way as tar
143 $dir =~ tr/./_/;
144 my(@pieces) = split(/\./,$base);
145 if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
146 my $okfile = "$dir$base";
147 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
148 $read->{"\L$okfile"}=$_;
149 }
150 else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
005c1a0e 151 }
152 close M;
153 $read;
154}
155
156# returns an anonymous sub that decides if an argument matches
157sub _maniskip {
158 my ($mfile) = @_;
159 my $matches = sub {0};
160 my @skip ;
15a074ca 161 $mfile ||= "$MANIFEST.SKIP";
005c1a0e 162 local *M;
163 return $matches unless -f $mfile;
164 open M, $mfile or return $matches;
165 while (<M>){
166 chomp;
15a074ca 167 next if /^#/;
005c1a0e 168 next if /^\s*$/;
169 push @skip, $_;
170 }
171 close M;
8e07c86e 172 my $opts = $Is_VMS ? 'oi ' : 'o ';
005c1a0e 173 my $sub = "\$matches = "
174 . "sub { my(\$arg)=\@_; return 1 if "
8e07c86e 175 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
005c1a0e 176 . " }";
177 eval $sub;
178 print "Debug: $sub\n" if $Debug;
179 $matches;
180}
181
182sub manicopy {
8e07c86e 183 my($read,$target,$how)=@_;
005c1a0e 184 croak "manicopy() called without target argument" unless defined $target;
15a074ca 185 $how ||= 'cp';
005c1a0e 186 require File::Path;
187 require File::Basename;
188 my(%dirs,$file);
8e07c86e 189 $target = VMS::Filespec::unixify($target) if $Is_VMS;
84876ac5 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 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 199 }
200}
201
202sub cp_if_diff {
8a1da95f 203 my($from, $to, $how)=@_;
15a074ca 204 -f $from or carp "$0: $from not found";
8e07c86e 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 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 227 }
228}
229
8e07c86e 230sub cp {
231 my ($srcFile, $dstFile) = @_;
79dd614e 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 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 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 245 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
246 unlink $dstFile;
247 return;
248 }
249 1;
8e07c86e 250}
251
4633a7c4 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 258 }
259}
260
005c1a0e 2611;
79dd614e 262
263__END__
264
265=head1 NAME
266
267ExtUtils::Manifest - utilities to write and check a MANIFEST file
268
269=head1 SYNOPSIS
270
d962e1c0 271 require ExtUtils::Manifest;
79dd614e 272
d962e1c0 273 ExtUtils::Manifest::mkmanifest;
79dd614e 274
d962e1c0 275 ExtUtils::Manifest::manicheck;
79dd614e 276
d962e1c0 277 ExtUtils::Manifest::filecheck;
79dd614e 278
d962e1c0 279 ExtUtils::Manifest::fullcheck;
79dd614e 280
d962e1c0 281 ExtUtils::Manifest::skipcheck;
79dd614e 282
d962e1c0 283 ExtUtils::Manifest::manifind();
79dd614e 284
d962e1c0 285 ExtUtils::Manifest::maniread($file);
79dd614e 286
d962e1c0 287 ExtUtils::Manifest::manicopy($read,$target,$how);
79dd614e 288
289=head1 DESCRIPTION
290
d962e1c0 291mkmanifest() writes all files in and below the current directory to a
79dd614e 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 302output. All files that match any regular expression in a file
303C<MANIFEST.SKIP> (if such a file exists) are ignored.
304
d962e1c0 305manicheck() checks if all the files within a C<MANIFEST> in the
f1387719 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 309
d962e1c0 310filecheck() finds files below the current directory that are not
79dd614e 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
d962e1c0 315fullcheck() does both a manicheck() and a filecheck().
79dd614e 316
d962e1c0 317skipcheck() lists all the files that are skipped due to your
79dd614e 318C<MANIFEST.SKIP> file.
319
d962e1c0 320manifind() returns a hash reference. The keys of the hash are the
79dd614e 321files found below the current directory.
322
d962e1c0 323maniread($file) reads a named C<MANIFEST> file (defaults to
79dd614e 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 326Blank lines and lines which start with C<#> in the C<MANIFEST> file
327are discarded.
79dd614e 328
d962e1c0 329C<manicopy($read,$target,$how)> copies the files that are the keys in
79dd614e 330the HASH I<%$read> to the named target directory. The HASH reference
d962e1c0 331$read is typically returned by the maniread() function. This
79dd614e 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 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 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 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 407
408=cut