lib/ExtUtils/Manifest.pm

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