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