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 File::Spec::Functions qw(splitpath);
   8 use Carp;
   9 use strict;
  10
  11 our ($VERSION,@ISA,@EXPORT_OK,
  12             $Is_MacOS,$Is_VMS,
  13             $Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);
  14
  15 $VERSION = 1.37_01;
  16 @ISA=('Exporter');
  17 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
  18               'skipcheck', 'maniread', 'manicopy');
  19
  20 $Is_MacOS = $^O eq 'MacOS';
  21 $Is_VMS = $^O eq 'VMS';
  22 require VMS::Filespec if $Is_VMS;
  23
  24 $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
  25 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
  26                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
  27 $Quiet = 0;
  28 $MANIFEST = 'MANIFEST';
  29 $DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP";
  30
  31 # Really cool fix from Ilya :)
  32 unless (defined $Config{d_link}) {
  33     no warnings;
  34     *ln = \&cp;
  35 }
  36
  37 sub mkmanifest {
  38     my $manimiss = 0;
  39     my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
  40     $read = {} if $manimiss;
  41     local *M;
  42     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
  43     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
  44     my $skip = _maniskip();
  45     my $found = manifind();
  46     my($key,$val,$file,%all);
  47     %all = (%$found, %$read);
  48     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
  49         if $manimiss; # add new MANIFEST to known file list
  50     foreach $file (sort keys %all) {
  51         if ($skip->($file)) {
  52             # Policy: only remove files if they're listed in MANIFEST.SKIP.
  53             # Don't remove files just because they don't exist.
  54             warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
  55             next;
  56         }
  57         if ($Verbose){
  58             warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
  59         }
  60         my $text = $all{$file};
  61         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
  62         $file = _unmacify($file);
  63         my $tabs = (5 - (length($file)+1)/8);
  64         $tabs = 1 if $tabs < 1;
  65         $tabs = 0 unless $text;
  66         print M $file, "\t" x $tabs, $text, "\n";
  67     }
  68     close M;
  69 }
  70
  71 # Geez, shouldn't this use File::Spec or File::Basename or something?
  72 # Why so careful about dependencies?
  73 sub clean_up_filename {
  74   my $filename = shift;
  75   $filename =~ s|^\./||;
  76   $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
  77   return $filename;
  78 }
  79
  80 sub manifind {
  81     my $p = shift || {};
  82     my $found = {};
  83
  84     my $wanted = sub {
  85         my $name = clean_up_filename($File::Find::name);
  86         warn "Debug: diskfile $name\n" if $Debug;
  87         return if -d $name;
  88
  89         if( $Is_VMS ) {
  90             $name =~ s#(.*)\.$#\L$1#;
  91             $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
  92         }
  93         $found->{$name} = "";
  94     };
  95
  96     # We have to use "$File::Find::dir/$_" in preprocess, because
  97     # $File::Find::name is unavailable.
  98     # Also, it's okay to use / here, because MANIFEST files use Unix-style
  99     # paths.
 100     find({wanted => $wanted,
 101           no_chdir => 1,
 102          },
 103          $Is_MacOS ? ":" : ".");
 104
 105     return $found;
 106 }
 107
 108 sub fullcheck {
 109     return [_check_files()], [_check_manifest()];
 110 }
 111
 112 sub manicheck {
 113     return _check_files();
 114 }
 115
 116 sub filecheck {
 117     return _check_manifest();
 118 }
 119
 120 sub skipcheck {
 121     my($p) = @_;
 122     my $found = manifind();
 123     my $matches = _maniskip();
 124
 125     my @skipped = ();
 126     foreach my $file (sort keys %$found){
 127         if (&$matches($file)){
 128             warn "Skipping $file\n";
 129             push @skipped, $file;
 130             next;
 131         }
 132     }
 133
 134     return @skipped;
 135 }
 136
 137
 138 sub _check_files {
 139     my $p = shift;
 140     my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
 141     my $read = maniread() || {};
 142     my $found = manifind($p);
 143
 144     my(@missfile) = ();
 145     foreach my $file (sort keys %$read){
 146         warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
 147         if ($dosnames){
 148             $file = lc $file;
 149             $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
 150             $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
 151         }
 152         unless ( exists $found->{$file} ) {
 153             warn "No such file: $file\n" unless $Quiet;
 154             push @missfile, $file;
 155         }
 156     }
 157
 158     return @missfile;
 159 }
 160
 161
 162 sub _check_manifest {
 163     my($p) = @_;
 164     my $read = maniread() || {};
 165     my $found = manifind($p);
 166     my $skip  = _maniskip();
 167
 168     my @missentry = ();
 169     foreach my $file (sort keys %$found){
 170         next if $skip->($file);
 171         warn "Debug: manicheck checking from disk $file\n" if $Debug;
 172         unless ( exists $read->{$file} ) {
 173             my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
 174             warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
 175             push @missentry, $file;
 176         }
 177     }
 178
 179     return @missentry;
 180 }
 181
 182
 183 sub maniread {
 184     my ($mfile) = @_;
 185     $mfile ||= $MANIFEST;
 186     my $read = {};
 187     local *M;
 188     unless (open M, $mfile){
 189         warn "$mfile: $!";
 190         return $read;
 191     }
 192     while (<M>){
 193         chomp;
 194         next if /^#/;
 195
 196         my($file, $comment) = /^(\S+)\s*(.*)/;
 197         next unless $file;
 198
 199         if ($Is_MacOS) {
 200             $file = _macify($file);
 201             $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
 202         }
 203         elsif ($Is_VMS) {
 204         require File::Basename;
 205             my($base,$dir) = File::Basename::fileparse($file);
 206             # Resolve illegal file specifications in the same way as tar
 207             $dir =~ tr/./_/;
 208             my(@pieces) = split(/\./,$base);
 209             if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
 210             my $okfile = "$dir$base";
 211             warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
 212             $file = $okfile;
 213             $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
 214         }
 215
 216         $read->{$file} = $comment;
 217     }
 218     close M;
 219     $read;
 220 }
 221
 222 # returns an anonymous sub that decides if an argument matches
 223 sub _maniskip {
 224     my @skip ;
 225     my $mfile = "$MANIFEST.SKIP";
 226     local *M;
 227     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
 228     while (<M>){
 229         chomp;
 230         next if /^#/;
 231         next if /^\s*$/;
 232         push @skip, _macify($_);
 233     }
 234     close M;
 235     my $opts = $Is_VMS ? '(?i)' : '';
 236
 237     # Make sure each entry is isolated in its own parentheses, in case
 238     # any of them contain alternations
 239     my $regex = join '|', map "(?:$_)", @skip;
 240
 241     return sub { $_[0] =~ qr{$opts$regex} };
 242 }
 243
 244 sub manicopy {
 245     my($read,$target,$how)=@_;
 246     croak "manicopy() called without target argument" unless defined $target;
 247     $how ||= 'cp';
 248     require File::Path;
 249     require File::Basename;
 250     my(%dirs,$file);
 251     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 252     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
 253     foreach $file (keys %$read){
 254         if ($Is_MacOS) {
 255             if ($file =~ m!:!) {
 256                 my $dir = _maccat($target, $file);
 257                 $dir =~ s/[^:]+$//;
 258                 File::Path::mkpath($dir,1,0755);
 259             }
 260             cp_if_diff($file, _maccat($target, $file), $how);
 261         } else {
 262             $file = VMS::Filespec::unixify($file) if $Is_VMS;
 263             if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 264                 my $dir = File::Basename::dirname($file);
 265                 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 266                 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
 267             }
 268             cp_if_diff($file, "$target/$file", $how);
 269         }
 270     }
 271 }
 272
 273 sub cp_if_diff {
 274     my($from, $to, $how)=@_;
 275     -f $from or carp "$0: $from not found";
 276     my($diff) = 0;
 277     local(*F,*T);
 278     open(F,"< $from\0") or croak "Can't read $from: $!\n";
 279     if (open(T,"< $to\0")) {
 280         while (<F>) { $diff++,last if $_ ne <T>; }
 281         $diff++ unless eof(T);
 282         close T;
 283     }
 284     else { $diff++; }
 285     close F;
 286     if ($diff) {
 287         if (-e $to) {
 288             unlink($to) or confess "unlink $to: $!";
 289         }
 290       STRICT_SWITCH: {
 291             best($from,$to), last STRICT_SWITCH if $how eq 'best';
 292             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 293             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 294             croak("ExtUtils::Manifest::cp_if_diff " .
 295                   "called with illegal how argument [$how]. " .
 296                   "Legal values are 'best', 'cp', and 'ln'.");
 297         }
 298     }
 299 }
 300
 301 sub cp {
 302     my ($srcFile, $dstFile) = @_;
 303     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
 304     copy($srcFile,$dstFile);
 305     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 306     # chmod a+rX-w,go-w
 307     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile )
 308       unless ($^O eq 'MacOS');
 309 }
 310
 311 sub ln {
 312     my ($srcFile, $dstFile) = @_;
 313     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
 314     link($srcFile, $dstFile);
 315     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
 316     my $mode= 0444 | (stat)[2] & 0700;
 317     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
 318        unlink $dstFile;
 319        return;
 320     }
 321     1;
 322 }
 323
 324 sub best {
 325     my ($srcFile, $dstFile) = @_;
 326     if (-l $srcFile) {
 327         cp($srcFile, $dstFile);
 328     } else {
 329         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
 330     }
 331 }
 332
 333 sub _macify {
 334     my($file) = @_;
 335
 336     return $file unless $Is_MacOS;
 337
 338     $file =~ s|^\./||;
 339     if ($file =~ m|/|) {
 340         $file =~ s|/+|:|g;
 341         $file = ":$file";
 342     }
 343
 344     $file;
 345 }
 346
 347 sub _maccat {
 348     my($f1, $f2) = @_;
 349
 350     return "$f1/$f2" unless $Is_MacOS;
 351
 352     $f1 .= ":$f2";
 353     $f1 =~ s/([^:]:):/$1/g;
 354     return $f1;
 355 }
 356
 357 sub _unmacify {
 358     my($file) = @_;
 359
 360     return $file unless $Is_MacOS;
 361
 362     $file =~ s|^:||;
 363     $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
 364     $file =~ y|:|/|;
 365
 366     $file;
 367 }
 368
 369 1;
 370
 371 __END__
 372
 373 =head1 NAME
 374
 375 ExtUtils::Manifest - utilities to write and check a MANIFEST file
 376
 377 =head1 SYNOPSIS
 378
 379     require ExtUtils::Manifest;
 380
 381     ExtUtils::Manifest::mkmanifest;
 382
 383     ExtUtils::Manifest::manicheck;
 384
 385     ExtUtils::Manifest::filecheck;
 386
 387     ExtUtils::Manifest::fullcheck;
 388
 389     ExtUtils::Manifest::skipcheck;
 390
 391     ExtUtils::Manifest::manifind();
 392
 393     ExtUtils::Manifest::maniread($file);
 394
 395     ExtUtils::Manifest::manicopy($read,$target,$how);
 396
 397 =head1 DESCRIPTION
 398
 399 mkmanifest() writes all files in and below the current directory to a
 400 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
 401 defaults to C<MANIFEST>) in the current directory. It works similar to
 402
 403     find . -print
 404
 405 but in doing so checks each line in an existing C<MANIFEST> file and
 406 includes any comments that are found in the existing C<MANIFEST> file
 407 in the new one. Anything between white space and an end of line within
 408 a C<MANIFEST> file is considered to be a comment. Filenames and
 409 comments are separated by one or more TAB characters in the
 410 output. All files that match any regular expression in a file
 411 C<MANIFEST.SKIP> (if such a file exists) are ignored.
 412
 413 manicheck() checks if all the files within a C<MANIFEST> in the current
 414 directory really do exist. If C<MANIFEST> and the tree below the current
 415 directory are in sync it exits silently, returning an empty list.  Otherwise
 416 it returns a list of files which are listed in the C<MANIFEST> but missing
 417 from the directory, and by default also outputs these names to STDERR.
 418
 419 filecheck() finds files below the current directory that are not
 420 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
 421 will be consulted. Any file matching a regular expression in such a
 422 file will not be reported as missing in the C<MANIFEST> file. The list of
 423 any extraneous files found is returned, and by default also reported to
 424 STDERR.
 425
 426 fullcheck() does both a manicheck() and a filecheck(), returning references
 427 to two arrays, the first for files manicheck() found to be missing, the
 428 seond for unexpeced files found by filecheck().
 429
 430 skipcheck() lists all the files that are skipped due to your
 431 C<MANIFEST.SKIP> file.
 432
 433 manifind() returns a hash reference. The keys of the hash are the
 434 files found below the current directory.
 435
 436 maniread($file) reads a named C<MANIFEST> file (defaults to
 437 C<MANIFEST> in the current directory) and returns a HASH reference
 438 with files being the keys and comments being the values of the HASH.
 439 Blank lines and lines which start with C<#> in the C<MANIFEST> file
 440 are discarded.
 441
 442 C<manicopy($read,$target,$how)> copies the files that are the keys in
 443 the HASH I<%$read> to the named target directory. The HASH reference
 444 $read is typically returned by the maniread() function. This
 445 function is useful for producing a directory tree identical to the
 446 intended distribution tree. The third parameter $how can be used to
 447 specify a different methods of "copying". Valid values are C<cp>,
 448 which actually copies the files, C<ln> which creates hard links, and
 449 C<best> which mostly links the files but copies any symbolic link to
 450 make a tree without any symbolic link. Best is the default.
 451
 452 =head1 MANIFEST.SKIP
 453
 454 The file MANIFEST.SKIP may contain regular expressions of files that
 455 should be ignored by mkmanifest() and filecheck(). The regular
 456 expressions should appear one on each line. Blank lines and lines
 457 which start with C<#> are skipped.  Use C<\#> if you need a regular
 458 expression to start with a sharp character. A typical example:
 459
 460     # Version control files and dirs.
 461     \bRCS\b
 462     \bCVS\b
 463     ,v$
 464
 465     # Makemaker generated files and dirs.
 466     ^MANIFEST\.
 467     ^Makefile$
 468     ^blib/
 469     ^MakeMaker-\d
 470
 471     # Temp, old and emacs backup files.
 472     ~$
 473     \.old$
 474     ^#.*#$
 475     ^\.#
 476
 477 If no MANIFEST.SKIP file is found, a default set of skips will be
 478 used, similar to the example above.  If you want nothing skipped,
 479 simply make an empty MANIFEST.SKIP file.
 480
 481
 482 =head1 EXPORT_OK
 483
 484 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 485 C<&maniread>, and C<&manicopy> are exportable.
 486
 487 =head1 GLOBAL VARIABLES
 488
 489 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 490 results in both a different C<MANIFEST> and a different
 491 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 492 different distributions for different audiences (say a user version
 493 and a developer version including RCS).
 494
 495 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 496 all functions act silently.
 497
 498 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
 499 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
 500 produced.
 501
 502 =head1 DIAGNOSTICS
 503
 504 All diagnostic output is sent to C<STDERR>.
 505
 506 =over 4
 507
 508 =item C<Not in MANIFEST:> I<file>
 509
 510 is reported if a file is found which is not in C<MANIFEST>.
 511
 512 =item C<Skipping> I<file>
 513
 514 is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
 515
 516 =item C<No such file:> I<file>
 517
 518 is reported if a file mentioned in a C<MANIFEST> file does not
 519 exist.
 520
 521 =item C<MANIFEST:> I<$!>
 522
 523 is reported if C<MANIFEST> could not be opened.
 524
 525 =item C<Added to MANIFEST:> I<file>
 526
 527 is reported by mkmanifest() if $Verbose is set and a file is added
 528 to MANIFEST. $Verbose is set to 1 by default.
 529
 530 =back
 531
 532 =head1 ENVIRONMENT
 533
 534 =over 4
 535
 536 =item B<PERL_MM_MANIFEST_DEBUG>
 537
 538 Turns on debugging
 539
 540 =back
 541
 542 =head1 SEE ALSO
 543
 544 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 545
 546 =head1 AUTHOR
 547
 548 Andreas Koenig <F<andreas.koenig@anima.de>>
 549
 550 =cut