lib/ExtUtils/Manifest.pm

   1 package ExtUtils::Manifest;
   2
   3 =head1 NAME
   4
   5 ExtUtils::Manifest - utilities to write and check a MANIFEST file
   6
   7 =head1 SYNOPSIS
   8
   9 C<require ExtUtils::Manifest;>
  10
  11 C<ExtUtils::Manifest::mkmanifest;>
  12
  13 C<ExtUtils::Manifest::manicheck;>
  14
  15 C<ExtUtils::Manifest::filecheck;>
  16
  17 C<ExtUtils::Manifest::fullcheck;>
  18
  19 C<ExtUtils::Manifest::maniread($file);>
  20
  21 C<ExtUtils::Manifest::manicopy($read,$target,$how);>
  22
  23 =head1 DESCRIPTION
  24
  25 Mkmanifest() writes all files in and below the current directory to a
  26 file named C<MANIFEST> in the current directory. It works similar to
  27
  28     find . -print
  29
  30 but in doing so checks each line in an existing C<MANIFEST> file and
  31 includes any comments that are found in the existing C<MANIFEST> file
  32 in the new one. Anything between white space and an end of line within
  33 a C<MANIFEST> file is considered to be a comment. Filenames and
  34 comments are seperated by one or more TAB characters in the
  35 output. All files that match any regular expression in a file
  36 C<MANIFEST.SKIP> (if such a file exists) are ignored.
  37
  38 Manicheck() checks if all the files within a C<MANIFEST> in the current
  39 directory really do exist.
  40
  41 Filecheck() finds files below the current directory that are not
  42 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
  43 will be consulted. Any file matching a regular expression in such a
  44 file will not be reported as missing in the C<MANIFEST> file.
  45
  46 Fullcheck() does both a manicheck() and a filecheck().
  47
  48 Maniread($file) reads a named C<MANIFEST> file (defaults to
  49 C<MANIFEST> in the current directory) and returns a HASH reference
  50 with files being the keys and comments being the values of the HASH.
  51
  52 I<Manicopy($read,$target,$how)> copies the files that are the keys in
  53 the HASH I<%$read> to the named target directory. The HASH reference
  54 I<$read> is typically returned by the maniread() function. This
  55 function is useful for producing a directory tree identical to the
  56 intended distribution tree. The third parameter $how can be used to
  57 specify a different system call to do the copying (eg. C<ln> instead
  58 of C<cp>, which is the default).
  59
  60 =head1 MANIFEST.SKIP
  61
  62 The file MANIFEST.SKIP may contain regular expressions of files that
  63 should be ignored by mkmanifest() and filecheck(). The regular
  64 expressions should appear one on each line. A typical example:
  65
  66     \bRCS\b
  67     ^MANIFEST\.
  68     ^Makefile$
  69     ~$
  70     \.html$
  71     \.old$
  72     ^blib/
  73     ^MakeMaker-\d
  74
  75 =head1 EXPORT_OK
  76
  77 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  78 C<&maniread>, and C<&manicopy> are exportable.
  79
  80 =head1 DIAGNOSTICS
  81
  82 All diagnostic output is sent to C<STDERR>.
  83
  84 =over
  85
  86 =item C<Not in MANIFEST:> I<file>
  87
  88 is reported if a file is found, that is missing in the C<MANIFEST>
  89 file which is excluded by a regular expression in the file
  90 C<MANIFEST.SKIP>.
  91
  92 =item C<No such file:> I<file>
  93
  94 is reported if a file mentioned in a C<MANIFEST> file does not
  95 exist.
  96
  97 =item C<MANIFEST:> I<$!>
  98
  99 is reported if C<MANIFEST> could not be opened.
 100
 101 =item C<Added to MANIFEST:> I<file>
 102
 103 is reported by mkmanifest() if $Verbose is set and a file is added
 104 to MANIFEST. $Verbose is set to 1 by default.
 105
 106 =back
 107
 108 =head1 AUTHOR
 109
 110 Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
 111
 112 =cut
 113
 114 require Exporter;
 115 @ISA=('Exporter');
 116 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
 117               'skipcheck', 'maniread', 'manicopy');
 118
 119 use Config;
 120 use File::Find;
 121 use Carp;
 122
 123 $Debug = 0;
 124 $Verbose = 1;
 125 $Is_VMS = $Config{'osname'} eq 'VMS';
 126
 127 ($Version) = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
 128 $Version = $Version; #avoid warning
 129
 130 $Quiet = 0;
 131
 132 sub mkmanifest {
 133     my $manimiss = 0;
 134     my $read = maniread() or $manimiss++;
 135     $read = {} if $manimiss;
 136     my $matches = _maniskip();
 137     my $found = manifind();
 138     my($key,$val,$file,%all);
 139     my %all = (%$found, %$read);
 140     local *M;
 141     rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
 142     open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
 143     foreach $file (sort keys %all) {
 144         next if &$matches($file);
 145         if ($Verbose){
 146             warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
 147         }
 148         my $text = $all{$file};
 149         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS;
 150         my $tabs = (5 - (length($file)+1)/8);
 151         $tabs = 1 if $tabs < 1;
 152         $tabs = 0 unless $text;
 153         print M $file, "\t" x $tabs, $text, "\n";
 154     }
 155     close M;
 156 }
 157
 158 sub manifind {
 159     local $found = {};
 160     find(sub {return if -d $File::Find::name;
 161               (my $name = $File::Find::name) =~ s|./||;
 162               warn "Debug: diskfile $name\n" if $Debug;
 163               $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
 164               $found->{$name} = "";}, ".");
 165     $found;
 166 }
 167
 168 sub fullcheck {
 169     _manicheck(3);
 170 }
 171
 172 sub manicheck {
 173     return @{(_manicheck(1))[0]};
 174 }
 175
 176 sub filecheck {
 177     return @{(_manicheck(2))[1]};
 178 }
 179
 180 sub skipcheck {
 181     _manicheck(6);
 182 }
 183
 184 sub _manicheck {
 185     my($arg) = @_;
 186     my $read = maniread();
 187     my $file;
 188     my(@missfile,@missentry);
 189     if ($arg & 1){
 190         my $found = manifind();
 191         foreach $file (sort keys %$read){
 192             warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
 193             unless ( exists $found->{$file} ) {
 194                 warn "No such file: $file\n" unless $Quiet;
 195                 push @missfile, $file;
 196             }
 197         }
 198     }
 199     if ($arg & 2){
 200         $read ||= {};
 201         my $matches = _maniskip();
 202         my $found = manifind();
 203         my $skipwarn = $arg & 4;
 204         foreach $file (sort keys %$found){
 205             if (&$matches($file)){
 206                 warn "Skipping $file\n" if $skipwarn;
 207                 next;
 208             }
 209             warn "Debug: manicheck checking from disk $file\n" if $Debug;
 210             unless ( exists $read->{$file} ) {
 211                 warn "Not in MANIFEST: $file\n" unless $Quiet;
 212                 push @missentry, $file;
 213             }
 214         }
 215     }
 216     (\@missfile,\@missentry);
 217 }
 218
 219 sub maniread {
 220     my ($mfile) = @_;
 221     $mfile = "MANIFEST" unless defined $mfile;
 222     my $read = {};
 223     local *M;
 224     unless (open M, $mfile){
 225         warn "$mfile: $!";
 226         return $read;
 227     }
 228     while (<M>){
 229         chomp;
 230         if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
 231         else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
 232     }
 233     close M;
 234     $read;
 235 }
 236
 237 # returns an anonymous sub that decides if an argument matches
 238 sub _maniskip {
 239     my ($mfile) = @_;
 240     my $matches = sub {0};
 241     my @skip ;
 242     my $mfile = "MANIFEST.SKIP" unless defined $mfile;
 243     local *M;
 244     return $matches unless -f $mfile;
 245     open M, $mfile or return $matches;
 246     while (<M>){
 247         chomp;
 248         next if /^\s*$/;
 249         push @skip, $_;
 250     }
 251     close M;
 252     my $opts = $Is_VMS ? 'oi ' : 'o ';
 253     my $sub = "\$matches = "
 254         . "sub { my(\$arg)=\@_; return 1 if "
 255         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
 256         . " }";
 257     eval $sub;
 258     print "Debug: $sub\n" if $Debug;
 259     $matches;
 260 }
 261
 262 sub manicopy {
 263     my($read,$target,$how)=@_;
 264     croak "manicopy() called without target argument" unless defined $target;
 265     $how = 'cp' unless defined $how && $how;
 266     require File::Path;
 267     require File::Basename;
 268     my(%dirs,$file);
 269     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 270     umask 0;
 271     foreach $file (keys %$read){
 272         $file = VMS::Filespec::unixify($file) if $Is_VMS;
 273         my $dir = File::Basename::dirname($file);
 274         File::Path::mkpath(["$target/$dir"],1,0755);
 275         if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
 276         else         { cp_if_diff($file, "$target/$file", $how); }
 277     }
 278 }
 279
 280 sub cp_if_diff {
 281     my($from,$to, $how)=@_;
 282     -f $from || carp "$0: $from not found";
 283     my($diff) = 0;
 284     local(*F,*T);
 285     open(F,$from) or croak "Can't read $from: $!\n";
 286     if (open(T,$to)) {
 287         while (<F>) { $diff++,last if $_ ne <T>; }
 288         $diff++ unless eof(T);
 289         close T;
 290     }
 291     else { $diff++; }
 292     close F;
 293     if ($diff) {
 294         if (-e $to) {
 295             unlink($to) or confess "unlink $to: $!";
 296         }
 297         &$how($from, $to);
 298     }
 299 }
 300
 301 # Do the comparisons here rather than spawning off another process
 302 sub vms_cp_if_diff {
 303     my($from,$to) = @_;
 304     my($diff) = 0;
 305     local(*F,*T);
 306     open(F,$from) or croak "Can't read $from: $!\n";
 307     if (open(T,$to)) {
 308         while (<F>) { $diff++,last if $_ ne <T>; }
 309         $diff++ unless eof(T);
 310         close T;
 311     }
 312     else { $diff++; }
 313     close F;
 314     if ($diff) {
 315         system('copy',vmsify($from),vmsify($to)) & 1
 316             or confess "Copy failed: $!";
 317     }
 318 }
 319
 320 sub cp {
 321     my ($srcFile, $dstFile) = @_;
 322     my $buf;
 323     open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n";
 324     open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n";
 325     my ($perm,$access,$mod) = (stat IN)[2,8,9];
 326     syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192);
 327     close IN;
 328     close OUT;
 329     utime $access, $mod, $dstFile;
 330     # chmod a+rX-w,go-w
 331     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 332 }
 333
 334 sub ln {
 335     my ($srcFile, $dstFile) = @_;
 336     link($srcFile, $dstFile);
 337     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
 338     my $mode= 0444 | (stat)[2] & 0700;
 339     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
 340 }
 341
 342 1;