lib/ExtUtils/Manifest.pm

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