Merge branch 'master' of http://repo.or.cz/r/msysgit into devel
[msysgit/historical-msysgit.git] / lib / perl5 / 5.6.1 / ExtUtils / Manifest.pm
blob26b4eb71cc49bdd6f311c535ae1505e41ebd241f
1 package ExtUtils::Manifest;
3 require Exporter;
4 use Config;
5 use File::Find;
6 use File::Copy 'copy';
7 use Carp;
8 use strict;
10 use vars qw($VERSION @ISA @EXPORT_OK
11 $Is_MacOS $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
13 $VERSION = substr(q$Revision: 1.34 $, 10);
14 @ISA=('Exporter');
15 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
16 'skipcheck', 'maniread', 'manicopy');
18 $Is_MacOS = $^O eq 'MacOS';
19 $Is_VMS = $^O eq 'VMS';
20 if ($Is_VMS) { require File::Basename }
22 $Debug = 0;
23 $Verbose = 1;
24 $Quiet = 0;
25 $MANIFEST = 'MANIFEST';
27 # Really cool fix from Ilya :)
28 unless (defined $Config{d_link}) {
29 no warnings;
30 *ln = \&cp;
33 sub mkmanifest {
34 my $manimiss = 0;
35 my $read = maniread() or $manimiss++;
36 $read = {} if $manimiss;
37 local *M;
38 rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
39 open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
40 my $matches = _maniskip();
41 my $found = manifind();
42 my($key,$val,$file,%all);
43 %all = (%$found, %$read);
44 $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
45 if $manimiss; # add new MANIFEST to known file list
46 foreach $file (sort keys %all) {
47 next if &$matches($file);
48 if ($Verbose){
49 warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
51 my $text = $all{$file};
52 ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
53 $file = _unmacify($file);
54 my $tabs = (5 - (length($file)+1)/8);
55 $tabs = 1 if $tabs < 1;
56 $tabs = 0 unless $text;
57 print M $file, "\t" x $tabs, $text, "\n";
59 close M;
62 sub manifind {
63 local $found = {};
64 find(sub {return if -d $_;
65 (my $name = $File::Find::name) =~ s|^\./||;
66 $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
67 warn "Debug: diskfile $name\n" if $Debug;
68 $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
69 $found->{$name} = "";}, $Is_MacOS ? ":" : ".");
70 $found;
73 sub fullcheck {
74 _manicheck(3);
77 sub manicheck {
78 return @{(_manicheck(1))[0]};
81 sub filecheck {
82 return @{(_manicheck(2))[1]};
85 sub skipcheck {
86 _manicheck(6);
89 sub _manicheck {
90 my($arg) = @_;
91 my $read = maniread();
92 my $found = manifind();
93 my $file;
94 my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
95 my(@missfile,@missentry);
96 if ($arg & 1){
97 foreach $file (sort keys %$read){
98 warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
99 if ($dosnames){
100 $file = lc $file;
101 $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
102 $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
104 unless ( exists $found->{$file} ) {
105 warn "No such file: $file\n" unless $Quiet;
106 push @missfile, $file;
110 if ($arg & 2){
111 $read ||= {};
112 my $matches = _maniskip();
113 my $skipwarn = $arg & 4;
114 foreach $file (sort keys %$found){
115 if (&$matches($file)){
116 warn "Skipping $file\n" if $skipwarn;
117 next;
119 warn "Debug: manicheck checking from disk $file\n" if $Debug;
120 unless ( exists $read->{$file} ) {
121 my $canon = "\t" . _unmacify($file) if $Is_MacOS;
122 warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
123 push @missentry, $file;
127 (\@missfile,\@missentry);
130 sub maniread {
131 my ($mfile) = @_;
132 $mfile ||= $MANIFEST;
133 my $read = {};
134 local *M;
135 unless (open M, $mfile){
136 warn "$mfile: $!";
137 return $read;
139 while (<M>){
140 chomp;
141 next if /^#/;
142 if ($Is_MacOS) {
143 my($item,$text) = /^(\S+)\s*(.*)/;
144 $item = _macify($item);
145 $item =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
146 $read->{$item}=$text;
148 elsif ($Is_VMS) {
149 my($file)= /^(\S+)/;
150 next unless $file;
151 my($base,$dir) = File::Basename::fileparse($file);
152 # Resolve illegal file specifications in the same way as tar
153 $dir =~ tr/./_/;
154 my(@pieces) = split(/\./,$base);
155 if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
156 my $okfile = "$dir$base";
157 warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
158 $read->{"\L$okfile"}=$_;
160 else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
162 close M;
163 $read;
166 # returns an anonymous sub that decides if an argument matches
167 sub _maniskip {
168 my ($mfile) = @_;
169 my $matches = sub {0};
170 my @skip ;
171 $mfile ||= "$MANIFEST.SKIP";
172 local *M;
173 return $matches unless -f $mfile;
174 open M, $mfile or return $matches;
175 while (<M>){
176 chomp;
177 next if /^#/;
178 next if /^\s*$/;
179 push @skip, _macify($_);
181 close M;
182 my $opts = $Is_VMS ? 'oi ' : 'o ';
183 my $sub = "\$matches = "
184 . "sub { my(\$arg)=\@_; return 1 if "
185 . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
186 . " }";
187 eval $sub;
188 print "Debug: $sub\n" if $Debug;
189 $matches;
192 sub manicopy {
193 my($read,$target,$how)=@_;
194 croak "manicopy() called without target argument" unless defined $target;
195 $how ||= 'cp';
196 require File::Path;
197 require File::Basename;
198 my(%dirs,$file);
199 $target = VMS::Filespec::unixify($target) if $Is_VMS;
200 File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
201 foreach $file (keys %$read){
202 if ($Is_MacOS) {
203 if ($file =~ m!:!) {
204 my $dir = _maccat($target, $file);
205 $dir =~ s/[^:]+$//;
206 File::Path::mkpath($dir,1,0755);
208 cp_if_diff($file, _maccat($target, $file), $how);
209 } else {
210 $file = VMS::Filespec::unixify($file) if $Is_VMS;
211 if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
212 my $dir = File::Basename::dirname($file);
213 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
214 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
216 cp_if_diff($file, "$target/$file", $how);
221 sub cp_if_diff {
222 my($from, $to, $how)=@_;
223 -f $from or carp "$0: $from not found";
224 my($diff) = 0;
225 local(*F,*T);
226 open(F,"< $from\0") or croak "Can't read $from: $!\n";
227 if (open(T,"< $to\0")) {
228 while (<F>) { $diff++,last if $_ ne <T>; }
229 $diff++ unless eof(T);
230 close T;
232 else { $diff++; }
233 close F;
234 if ($diff) {
235 if (-e $to) {
236 unlink($to) or confess "unlink $to: $!";
238 STRICT_SWITCH: {
239 best($from,$to), last STRICT_SWITCH if $how eq 'best';
240 cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
241 ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
242 croak("ExtUtils::Manifest::cp_if_diff " .
243 "called with illegal how argument [$how]. " .
244 "Legal values are 'best', 'cp', and 'ln'.");
249 sub cp {
250 my ($srcFile, $dstFile) = @_;
251 my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
252 copy($srcFile,$dstFile);
253 utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
254 # chmod a+rX-w,go-w
255 chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS');
258 sub ln {
259 my ($srcFile, $dstFile) = @_;
260 return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
261 link($srcFile, $dstFile);
262 local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
263 my $mode= 0444 | (stat)[2] & 0700;
264 if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
265 unlink $dstFile;
266 return;
271 sub best {
272 my ($srcFile, $dstFile) = @_;
273 if (-l $srcFile) {
274 cp($srcFile, $dstFile);
275 } else {
276 ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
280 sub _macify {
281 my($file) = @_;
283 return $file unless $Is_MacOS;
285 $file =~ s|^\./||;
286 if ($file =~ m|/|) {
287 $file =~ s|/+|:|g;
288 $file = ":$file";
291 $file;
294 sub _maccat {
295 my($f1, $f2) = @_;
297 return "$f1/$f2" unless $Is_MacOS;
299 $f1 .= ":$f2";
300 $f1 =~ s/([^:]:):/$1/g;
301 return $f1;
304 sub _unmacify {
305 my($file) = @_;
307 return $file unless $Is_MacOS;
309 $file =~ s|^:||;
310 $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
311 $file =~ y|:|/|;
313 $file;
318 __END__
320 =head1 NAME
322 ExtUtils::Manifest - utilities to write and check a MANIFEST file
324 =head1 SYNOPSIS
326 require ExtUtils::Manifest;
328 ExtUtils::Manifest::mkmanifest;
330 ExtUtils::Manifest::manicheck;
332 ExtUtils::Manifest::filecheck;
334 ExtUtils::Manifest::fullcheck;
336 ExtUtils::Manifest::skipcheck;
338 ExtUtils::Manifest::manifind();
340 ExtUtils::Manifest::maniread($file);
342 ExtUtils::Manifest::manicopy($read,$target,$how);
344 =head1 DESCRIPTION
346 mkmanifest() writes all files in and below the current directory to a
347 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
348 defaults to C<MANIFEST>) in the current directory. It works similar to
350 find . -print
352 but in doing so checks each line in an existing C<MANIFEST> file and
353 includes any comments that are found in the existing C<MANIFEST> file
354 in the new one. Anything between white space and an end of line within
355 a C<MANIFEST> file is considered to be a comment. Filenames and
356 comments are separated by one or more TAB characters in the
357 output. All files that match any regular expression in a file
358 C<MANIFEST.SKIP> (if such a file exists) are ignored.
360 manicheck() checks if all the files within a C<MANIFEST> in the
361 current directory really do exist. It only reports discrepancies and
362 exits silently if MANIFEST and the tree below the current directory
363 are in sync.
365 filecheck() finds files below the current directory that are not
366 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
367 will be consulted. Any file matching a regular expression in such a
368 file will not be reported as missing in the C<MANIFEST> file.
370 fullcheck() does both a manicheck() and a filecheck().
372 skipcheck() lists all the files that are skipped due to your
373 C<MANIFEST.SKIP> file.
375 manifind() returns a hash reference. The keys of the hash are the
376 files found below the current directory.
378 maniread($file) reads a named C<MANIFEST> file (defaults to
379 C<MANIFEST> in the current directory) and returns a HASH reference
380 with files being the keys and comments being the values of the HASH.
381 Blank lines and lines which start with C<#> in the C<MANIFEST> file
382 are discarded.
384 C<manicopy($read,$target,$how)> copies the files that are the keys in
385 the HASH I<%$read> to the named target directory. The HASH reference
386 $read is typically returned by the maniread() function. This
387 function is useful for producing a directory tree identical to the
388 intended distribution tree. The third parameter $how can be used to
389 specify a different methods of "copying". Valid values are C<cp>,
390 which actually copies the files, C<ln> which creates hard links, and
391 C<best> which mostly links the files but copies any symbolic link to
392 make a tree without any symbolic link. Best is the default.
394 =head1 MANIFEST.SKIP
396 The file MANIFEST.SKIP may contain regular expressions of files that
397 should be ignored by mkmanifest() and filecheck(). The regular
398 expressions should appear one on each line. Blank lines and lines
399 which start with C<#> are skipped. Use C<\#> if you need a regular
400 expression to start with a sharp character. A typical example:
402 \bRCS\b
403 ^MANIFEST\.
404 ^Makefile$
406 \.html$
407 \.old$
408 ^blib/
409 ^MakeMaker-\d
411 =head1 EXPORT_OK
413 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
414 C<&maniread>, and C<&manicopy> are exportable.
416 =head1 GLOBAL VARIABLES
418 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
419 results in both a different C<MANIFEST> and a different
420 C<MANIFEST.SKIP> file. This is useful if you want to maintain
421 different distributions for different audiences (say a user version
422 and a developer version including RCS).
424 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
425 all functions act silently.
427 =head1 DIAGNOSTICS
429 All diagnostic output is sent to C<STDERR>.
431 =over
433 =item C<Not in MANIFEST:> I<file>
435 is reported if a file is found, that is missing in the C<MANIFEST>
436 file which is excluded by a regular expression in the file
437 C<MANIFEST.SKIP>.
439 =item C<No such file:> I<file>
441 is reported if a file mentioned in a C<MANIFEST> file does not
442 exist.
444 =item C<MANIFEST:> I<$!>
446 is reported if C<MANIFEST> could not be opened.
448 =item C<Added to MANIFEST:> I<file>
450 is reported by mkmanifest() if $Verbose is set and a file is added
451 to MANIFEST. $Verbose is set to 1 by default.
453 =back
455 =head1 SEE ALSO
457 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
459 =head1 AUTHOR
461 Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>>
463 =cut