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