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);>
  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)> copies the files that are the keys in the
  53 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.
  57
  58 =head1 MANIFEST.SKIP
  59
  60 The file MANIFEST.SKIP may contain regular expressions of files that
  61 should be ignored by mkmanifest() and filecheck(). The regular
  62 expressions should appear one on each line. A typical example:
  63
  64     \bRCS\b
  65     ^MANIFEST\.
  66     ^Makefile$
  67     ~$
  68     \.html$
  69     \.old$
  70     ^blib/
  71     ^MakeMaker-\d
  72
  73 =head1 EXPORT_OK
  74
  75 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  76 C<&maniread>, and C<&manicopy> are exportable.
  77
  78 =head1 DIAGNOSTICS
  79
  80 All diagnostic output is sent to C<STDERR>.
  81
  82 =over
  83
  84 =item C<Not in MANIFEST:> I<file>
  85 is reported if a file is found, that is missing in the C<MANIFEST>
  86 file which is excluded by a regular expression in the file
  87 C<MANIFEST.SKIP>.
  88
  89 =item C<No such file:> I<file>
  90 is reported if a file mentioned in a C<MANIFEST> file does not
  91 exist.
  92
  93 =item C<MANIFEST:> I<$!>
  94 is reported if C<MANIFEST> could not be opened.
  95
  96 =item C<Added to MANIFEST:> I<file>
  97 is reported by mkmanifest() if $Verbose is set and a file is added
  98 to MANIFEST. $Verbose is set to 1 by default.
  99
 100 =back
 101
 102 =head1 AUTHOR
 103
 104 Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
 105
 106 =cut
 107
 108 require Exporter;
 109 @ISA=('Exporter');
 110 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
 111               'maniread', 'manicopy');
 112
 113 use File::Find;
 114 use Carp;
 115
 116 $Debug = 0;
 117 $Verbose = 1;
 118
 119 ($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
 120 $Version = $Version; #avoid warning
 121
 122 $Quiet = 0;
 123
 124 sub mkmanifest {
 125     my $manimiss = 0;
 126     my $read = maniread() or $manimiss++;
 127     $read = {} if $manimiss;
 128     my $matches = _maniskip();
 129     my $found = manifind();
 130     my($key,$val,$file,%all);
 131     my %all = (%$found, %$read);
 132     local *M;
 133     rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
 134     open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
 135     foreach $file (sort keys %all) {
 136         next if &$matches($file);
 137         if ($Verbose){
 138             warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
 139         }
 140         my $tabs = (5 - (length($file)+1)/8);
 141         $tabs = 1 if $tabs < 1;
 142         $tabs = 0 unless $all{$file};
 143         print M $file, "\t" x $tabs, $all{$file}, "\n";
 144     }
 145     close M;
 146 }
 147
 148 sub manifind {
 149     local $found = {};
 150     find(sub {return if -d $_;
 151               (my $name = $File::Find::name) =~ s|./||;
 152               warn "Debug: diskfile $name\n" if $Debug;
 153               $found->{$name} = "";}, ".");
 154     $found;
 155 }
 156
 157 sub fullcheck {
 158     _manicheck(3);
 159 }
 160
 161 sub manicheck {
 162     return @{(_manicheck(1))[0]};
 163 }
 164
 165 sub filecheck {
 166     return @{(_manicheck(2))[1]};
 167 }
 168
 169 sub _manicheck {
 170     my($arg) = @_;
 171     my $read = maniread();
 172     my $file;
 173     my(@missfile,@missentry);
 174     if ($arg & 1){
 175         my $found = manifind();
 176         foreach $file (sort keys %$read){
 177             warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
 178             unless ( exists $found->{$file} ) {
 179               warn "No such file: $file\n" unless $Quiet;
 180               push @missfile, $file;
 181             }
 182         }
 183     }
 184     if ($arg & 2){
 185         $read ||= {};
 186         my $matches = _maniskip();
 187         my $found = manifind();
 188         foreach $file (sort keys %$found){
 189             next if &$matches($file);
 190             warn "Debug: manicheck checking from disk $file\n" if $Debug;
 191             unless ( exists $read->{$file} ) {
 192               warn "Not in MANIFEST: $file\n" unless $Quiet;
 193               push @missentry, $file;
 194             }
 195         }
 196     }
 197     (\@missfile,\@missentry);
 198 }
 199
 200 sub maniread {
 201     my ($mfile) = @_;
 202     $mfile = "MANIFEST" unless defined $mfile;
 203     my $read = {};
 204     local *M;
 205     unless (open M, $mfile){
 206         warn "$mfile: $!";
 207         return $read;
 208     }
 209     while (<M>){
 210         chomp;
 211         /^(\S+)\s*(.*)/ and $read->{$1}=$2;
 212     }
 213     close M;
 214     $read;
 215 }
 216
 217 # returns an anonymous sub that decides if an argument matches
 218 sub _maniskip {
 219     my ($mfile) = @_;
 220     my $matches = sub {0};
 221     my @skip ;
 222     my $mfile = "MANIFEST.SKIP" unless defined $mfile;
 223     local *M;
 224     return $matches unless -f $mfile;
 225     open M, $mfile or return $matches;
 226     while (<M>){
 227         chomp;
 228         next if /^\s*$/;
 229         push @skip, $_;
 230     }
 231     close M;
 232     my $sub = "\$matches = "
 233         . "sub { my(\$arg)=\@_; return 1 if "
 234         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0)
 235         . " }";
 236     eval $sub;
 237     print "Debug: $sub\n" if $Debug;
 238     $matches;
 239 }
 240
 241 sub manicopy {
 242     my($read,$target)=@_;
 243     croak "manicopy() called without target argument" unless defined $target;
 244     require File::Path;
 245     require File::Basename;
 246     my(%dirs,$file);
 247     foreach $file (keys %$read){
 248         my $dir = File::Basename::dirname($file);
 249         File::Path::mkpath("$target/$dir");
 250         cp_if_diff($file, "$target/$file");
 251     }
 252 }
 253
 254 sub cp_if_diff {
 255     my($from,$to)=@_;
 256     -f $from || carp "$0: $from not found";
 257     system "cmp", "-s", $from, $to;
 258     if ($?) {
 259         unlink($to);   # In case we don't have write permissions.
 260         (system 'cp', $from, $to) == 0 or confess "system 'cp': $!";
 261     }
 262 }
 263
 264 1;