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.16 $,10,4);
 140
 141 $Quiet = 0;
 142
 143 sub mkmanifest {
 144     my $manimiss = 0;
 145     my $read = maniread() or $manimiss++;
 146     $read = {} if $manimiss;
 147     local *M;
 148     rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
 149     open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
 150     my $matches = _maniskip();
 151     my $found = manifind();
 152     my($key,$val,$file,%all);
 153     my %all = (%$found, %$read);
 154     foreach $file (sort keys %all) {
 155         next if &$matches($file);
 156         if ($Verbose){
 157             warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
 158         }
 159         my $text = $all{$file};
 160         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS;
 161         my $tabs = (5 - (length($file)+1)/8);
 162         $tabs = 1 if $tabs < 1;
 163         $tabs = 0 unless $text;
 164         print M $file, "\t" x $tabs, $text, "\n";
 165     }
 166     close M;
 167 }
 168
 169 sub manifind {
 170     local $found = {};
 171     find(sub {return if -d $_;
 172               (my $name = $File::Find::name) =~ s|./||;
 173               warn "Debug: diskfile $name\n" if $Debug;
 174               $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
 175               $found->{$name} = "";}, ".");
 176     $found;
 177 }
 178
 179 sub fullcheck {
 180     _manicheck(3);
 181 }
 182
 183 sub manicheck {
 184     return @{(_manicheck(1))[0]};
 185 }
 186
 187 sub filecheck {
 188     return @{(_manicheck(2))[1]};
 189 }
 190
 191 sub skipcheck {
 192     _manicheck(6);
 193 }
 194
 195 sub _manicheck {
 196     my($arg) = @_;
 197     my $read = maniread();
 198     my $file;
 199     my(@missfile,@missentry);
 200     if ($arg & 1){
 201         my $found = manifind();
 202         foreach $file (sort keys %$read){
 203             warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
 204             unless ( exists $found->{$file} ) {
 205                 warn "No such file: $file\n" unless $Quiet;
 206                 push @missfile, $file;
 207             }
 208         }
 209     }
 210     if ($arg & 2){
 211         $read ||= {};
 212         my $matches = _maniskip();
 213         my $found = manifind();
 214         my $skipwarn = $arg & 4;
 215         foreach $file (sort keys %$found){
 216             if (&$matches($file)){
 217                 warn "Skipping $file\n" if $skipwarn;
 218                 next;
 219             }
 220             warn "Debug: manicheck checking from disk $file\n" if $Debug;
 221             unless ( exists $read->{$file} ) {
 222                 warn "Not in MANIFEST: $file\n" unless $Quiet;
 223                 push @missentry, $file;
 224             }
 225         }
 226     }
 227     (\@missfile,\@missentry);
 228 }
 229
 230 sub maniread {
 231     my ($mfile) = @_;
 232     $mfile = "MANIFEST" unless defined $mfile;
 233     my $read = {};
 234     local *M;
 235     unless (open M, $mfile){
 236         warn "$mfile: $!";
 237         return $read;
 238     }
 239     while (<M>){
 240         chomp;
 241         if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
 242         else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
 243     }
 244     close M;
 245     $read;
 246 }
 247
 248 # returns an anonymous sub that decides if an argument matches
 249 sub _maniskip {
 250     my ($mfile) = @_;
 251     my $matches = sub {0};
 252     my @skip ;
 253     my $mfile = "MANIFEST.SKIP" unless defined $mfile;
 254     local *M;
 255     return $matches unless -f $mfile;
 256     open M, $mfile or return $matches;
 257     while (<M>){
 258         chomp;
 259         next if /^\s*$/;
 260         push @skip, $_;
 261     }
 262     close M;
 263     my $opts = $Is_VMS ? 'oi ' : 'o ';
 264     my $sub = "\$matches = "
 265         . "sub { my(\$arg)=\@_; return 1 if "
 266         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
 267         . " }";
 268     eval $sub;
 269     print "Debug: $sub\n" if $Debug;
 270     $matches;
 271 }
 272
 273 sub manicopy {
 274     my($read,$target,$how)=@_;
 275     croak "manicopy() called without target argument" unless defined $target;
 276     $how = 'cp' unless defined $how && $how;
 277     require File::Path;
 278     require File::Basename;
 279     my(%dirs,$file);
 280     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 281     umask 0;
 282     foreach $file (keys %$read){
 283         $file = VMS::Filespec::unixify($file) if $Is_VMS;
 284         my $dir = File::Basename::dirname($file);
 285         File::Path::mkpath(["$target/$dir"],1,0755);
 286         if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
 287         else         { cp_if_diff($file, "$target/$file", $how); }
 288     }
 289 }
 290
 291 sub cp_if_diff {
 292     my($from,$to, $how)=@_;
 293     -f $from || carp "$0: $from not found";
 294     my($diff) = 0;
 295     local(*F,*T);
 296     open(F,$from) or croak "Can't read $from: $!\n";
 297     if (open(T,$to)) {
 298         while (<F>) { $diff++,last if $_ ne <T>; }
 299         $diff++ unless eof(T);
 300         close T;
 301     }
 302     else { $diff++; }
 303     close F;
 304     if ($diff) {
 305         if (-e $to) {
 306             unlink($to) or confess "unlink $to: $!";
 307         }
 308         &$how($from, $to);
 309     }
 310 }
 311
 312 # Do the comparisons here rather than spawning off another process
 313 sub vms_cp_if_diff {
 314     my($from,$to) = @_;
 315     my($diff) = 0;
 316     local(*F,*T);
 317     open(F,$from) or croak "Can't read $from: $!\n";
 318     if (open(T,$to)) {
 319         while (<F>) { $diff++,last if $_ ne <T>; }
 320         $diff++ unless eof(T);
 321         close T;
 322     }
 323     else { $diff++; }
 324     close F;
 325     if ($diff) {
 326         system('copy',vmsify($from),vmsify($to)) & 1
 327             or confess "Copy failed: $!";
 328     }
 329 }
 330
 331 sub cp {
 332     my ($srcFile, $dstFile) = @_;
 333     my $buf;
 334     open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n";
 335     open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n";
 336     my ($perm,$access,$mod) = (stat IN)[2,8,9];
 337     syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192);
 338     close IN;
 339     close OUT;
 340     utime $access, $mod, $dstFile;
 341     # chmod a+rX-w,go-w
 342     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 343 }
 344
 345 sub ln {
 346     my ($srcFile, $dstFile) = @_;
 347     link($srcFile, $dstFile);
 348     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
 349     my $mode= 0444 | (stat)[2] & 0700;
 350     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
 351 }
 352
 353 sub best {
 354     my ($srcFile, $dstFile) = @_;
 355     if (-l $srcFile) {
 356         cp($srcFile, $dstFile);
 357     } else {
 358         ln($srcFile, $dstFile);
 359     }
 360 }
 361
 362 1;