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