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