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.43;
  16 @ISA=('Exporter');
  17 @EXPORT_OK = qw(mkmanifest
  18                 manicheck  filecheck  fullcheck  skipcheck
  19                 manifind   maniread   manicopy   maniadd
  20                );
  21
  22 $Is_MacOS = $^O eq 'MacOS';
  23 $Is_VMS   = $^O eq 'VMS';
  24 require VMS::Filespec if $Is_VMS;
  25
  26 $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
  27 $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
  28                    $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
  29 $Quiet = 0;
  30 $MANIFEST = 'MANIFEST';
  31
  32 my $Filename = __FILE__;
  33 $DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
  34                  "$MANIFEST.SKIP";
  35
  36
  37 =head1 NAME
  38
  39 ExtUtils::Manifest - utilities to write and check a MANIFEST file
  40
  41 =head1 SYNOPSIS
  42
  43     use ExtUtils::Manifest qw(...funcs to import...);
  44
  45     mkmanifest();
  46
  47     my @missing_files    = manicheck;
  48     my @skipped          = skipcheck;
  49     my @extra_files      = filecheck;
  50     my($missing, $extra) = fullcheck;
  51
  52     my $found    = manifind();
  53
  54     my $manifest = maniread();
  55
  56     manicopy($read,$target);
  57
  58     maniadd({$file => $comment, ...});
  59
  60
  61 =head1 DESCRIPTION
  62
  63 =head2 Functions
  64
  65 ExtUtils::Manifest exports no functions by default.  The following are
  66 exported on request
  67
  68 =over 4
  69
  70 =item mkmanifest
  71
  72     mkmanifest();
  73
  74 Writes all files in and below the current directory to your F<MANIFEST>.
  75 It works similar to
  76
  77     find . > MANIFEST
  78
  79 All files that match any regular expression in a file F<MANIFEST.SKIP>
  80 (if it exists) are ignored.
  81
  82 Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.  Lines
  83 from the old F<MANIFEST> file is preserved, including any comments
  84 that are found in the existing F<MANIFEST> file in the new one.
  85
  86 =cut
  87
  88 sub _sort {
  89     return sort { lc $a cmp lc $b } @_;
  90 }
  91
  92 sub mkmanifest {
  93     my $manimiss = 0;
  94     my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
  95     $read = {} if $manimiss;
  96     local *M;
  97     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
  98     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
  99     my $skip = _maniskip();
 100     my $found = manifind();
 101     my($key,$val,$file,%all);
 102     %all = (%$found, %$read);
 103     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
 104         if $manimiss; # add new MANIFEST to known file list
 105     foreach $file (_sort keys %all) {
 106         if ($skip->($file)) {
 107             # Policy: only remove files if they're listed in MANIFEST.SKIP.
 108             # Don't remove files just because they don't exist.
 109             warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
 110             next;
 111         }
 112         if ($Verbose){
 113             warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
 114         }
 115         my $text = $all{$file};
 116         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
 117         $file = _unmacify($file);
 118         my $tabs = (5 - (length($file)+1)/8);
 119         $tabs = 1 if $tabs < 1;
 120         $tabs = 0 unless $text;
 121         print M $file, "\t" x $tabs, $text, "\n";
 122     }
 123     close M;
 124 }
 125
 126 # Geez, shouldn't this use File::Spec or File::Basename or something?
 127 # Why so careful about dependencies?
 128 sub clean_up_filename {
 129   my $filename = shift;
 130   $filename =~ s|^\./||;
 131   $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
 132   return $filename;
 133 }
 134
 135
 136 =item manifind
 137
 138     my $found = manifind();
 139
 140 returns a hash reference. The keys of the hash are the files found
 141 below the current directory.
 142
 143 =cut
 144
 145 sub manifind {
 146     my $p = shift || {};
 147     my $found = {};
 148
 149     my $wanted = sub {
 150         my $name = clean_up_filename($File::Find::name);
 151         warn "Debug: diskfile $name\n" if $Debug;
 152         return if -d $_;
 153
 154         if( $Is_VMS ) {
 155             $name =~ s#(.*)\.$#\L$1#;
 156             $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
 157         }
 158         $found->{$name} = "";
 159     };
 160
 161     # We have to use "$File::Find::dir/$_" in preprocess, because
 162     # $File::Find::name is unavailable.
 163     # Also, it's okay to use / here, because MANIFEST files use Unix-style
 164     # paths.
 165     find({wanted => $wanted},
 166          $Is_MacOS ? ":" : ".");
 167
 168     return $found;
 169 }
 170
 171
 172 =item manicheck
 173
 174     my @missing_files = manicheck();
 175
 176 checks if all the files within a C<MANIFEST> in the current directory
 177 really do exist. If C<MANIFEST> and the tree below the current
 178 directory are in sync it silently returns an empty list.
 179 Otherwise it returns a list of files which are listed in the
 180 C<MANIFEST> but missing from the directory, and by default also
 181 outputs these names to STDERR.
 182
 183 =cut
 184
 185 sub manicheck {
 186     return _check_files();
 187 }
 188
 189
 190 =item filecheck
 191
 192     my @extra_files = filecheck();
 193
 194 finds files below the current directory that are not mentioned in the
 195 C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
 196 consulted. Any file matching a regular expression in such a file will
 197 not be reported as missing in the C<MANIFEST> file. The list of any
 198 extraneous files found is returned, and by default also reported to
 199 STDERR.
 200
 201 =cut
 202
 203 sub filecheck {
 204     return _check_manifest();
 205 }
 206
 207
 208 =item fullcheck
 209
 210     my($missing, $extra) = fullcheck();
 211
 212 does both a manicheck() and a filecheck(), returning then as two array
 213 refs.
 214
 215 =cut
 216
 217 sub fullcheck {
 218     return [_check_files()], [_check_manifest()];
 219 }
 220
 221
 222 =item skipcheck
 223
 224     my @skipped = skipcheck();
 225
 226 lists all the files that are skipped due to your C<MANIFEST.SKIP>
 227 file.
 228
 229 =cut
 230
 231 sub skipcheck {
 232     my($p) = @_;
 233     my $found = manifind();
 234     my $matches = _maniskip();
 235
 236     my @skipped = ();
 237     foreach my $file (_sort keys %$found){
 238         if (&$matches($file)){
 239             warn "Skipping $file\n";
 240             push @skipped, $file;
 241             next;
 242         }
 243     }
 244
 245     return @skipped;
 246 }
 247
 248
 249 sub _check_files {
 250     my $p = shift;
 251     my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
 252     my $read = maniread() || {};
 253     my $found = manifind($p);
 254
 255     my(@missfile) = ();
 256     foreach my $file (_sort keys %$read){
 257         warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
 258         if ($dosnames){
 259             $file = lc $file;
 260             $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
 261             $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
 262         }
 263         unless ( exists $found->{$file} ) {
 264             warn "No such file: $file\n" unless $Quiet;
 265             push @missfile, $file;
 266         }
 267     }
 268
 269     return @missfile;
 270 }
 271
 272
 273 sub _check_manifest {
 274     my($p) = @_;
 275     my $read = maniread() || {};
 276     my $found = manifind($p);
 277     my $skip  = _maniskip();
 278
 279     my @missentry = ();
 280     foreach my $file (_sort keys %$found){
 281         next if $skip->($file);
 282         warn "Debug: manicheck checking from disk $file\n" if $Debug;
 283         unless ( exists $read->{$file} ) {
 284             my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
 285             warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
 286             push @missentry, $file;
 287         }
 288     }
 289
 290     return @missentry;
 291 }
 292
 293
 294 =item maniread
 295
 296     my $manifest = maniread();
 297     my $manifest = maniread($manifest_file);
 298
 299 reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
 300 directory) and returns a HASH reference with files being the keys and
 301 comments being the values of the HASH.  Blank lines and lines which
 302 start with C<#> in the C<MANIFEST> file are discarded.
 303
 304 =cut
 305
 306 sub maniread {
 307     my ($mfile) = @_;
 308     $mfile ||= $MANIFEST;
 309     my $read = {};
 310     local *M;
 311     unless (open M, $mfile){
 312         warn "$mfile: $!";
 313         return $read;
 314     }
 315     local $_;
 316     while (<M>){
 317         chomp;
 318         next if /^\s*#/;
 319
 320         my($file, $comment) = /^(\S+)\s*(.*)/;
 321         next unless $file;
 322
 323         if ($Is_MacOS) {
 324             $file = _macify($file);
 325             $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
 326         }
 327         elsif ($Is_VMS) {
 328             require File::Basename;
 329             my($base,$dir) = File::Basename::fileparse($file);
 330             # Resolve illegal file specifications in the same way as tar
 331             $dir =~ tr/./_/;
 332             my(@pieces) = split(/\./,$base);
 333             if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
 334             my $okfile = "$dir$base";
 335             warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
 336             $file = $okfile;
 337             $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
 338         }
 339
 340         $read->{$file} = $comment;
 341     }
 342     close M;
 343     $read;
 344 }
 345
 346 # returns an anonymous sub that decides if an argument matches
 347 sub _maniskip {
 348     my @skip ;
 349     my $mfile = "$MANIFEST.SKIP";
 350     local(*M,$_);
 351     open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
 352     while (<M>){
 353         chomp;
 354         next if /^#/;
 355         next if /^\s*$/;
 356         push @skip, _macify($_);
 357     }
 358     close M;
 359     my $opts = $Is_VMS ? '(?i)' : '';
 360
 361     # Make sure each entry is isolated in its own parentheses, in case
 362     # any of them contain alternations
 363     my $regex = join '|', map "(?:$_)", @skip;
 364
 365     return sub { $_[0] =~ qr{$opts$regex} };
 366 }
 367
 368 =item manicopy
 369
 370     manicopy(\%src, $dest_dir);
 371     manicopy(\%src, $dest_dir, $how);
 372
 373 Copies the files that are the keys in %src to the $dest_dir.  %src is
 374 typically returned by the maniread() function.
 375
 376     manicopy( maniread(), $dest_dir );
 377
 378 This function is useful for producing a directory tree identical to the
 379 intended distribution tree.
 380
 381 $how can be used to specify a different methods of "copying".  Valid
 382 values are C<cp>, which actually copies the files, C<ln> which creates
 383 hard links, and C<best> which mostly links the files but copies any
 384 symbolic link to make a tree without any symbolic link.  C<cp> is the
 385 default.
 386
 387 =cut
 388
 389 sub manicopy {
 390     my($read,$target,$how)=@_;
 391     croak "manicopy() called without target argument" unless defined $target;
 392     $how ||= 'cp';
 393     require File::Path;
 394     require File::Basename;
 395
 396     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 397     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
 398     foreach my $file (keys %$read){
 399         if ($Is_MacOS) {
 400             if ($file =~ m!:!) {
 401                 my $dir = _maccat($target, $file);
 402                 $dir =~ s/[^:]+$//;
 403                 File::Path::mkpath($dir,1,0755);
 404             }
 405             cp_if_diff($file, _maccat($target, $file), $how);
 406         } else {
 407             $file = VMS::Filespec::unixify($file) if $Is_VMS;
 408             if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 409                 my $dir = File::Basename::dirname($file);
 410                 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 411                 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
 412             }
 413             cp_if_diff($file, "$target/$file", $how);
 414         }
 415     }
 416 }
 417
 418 sub cp_if_diff {
 419     my($from, $to, $how)=@_;
 420     -f $from or carp "$0: $from not found";
 421     my($diff) = 0;
 422     local(*F,*T);
 423     open(F,"< $from\0") or die "Can't read $from: $!\n";
 424     if (open(T,"< $to\0")) {
 425         local $_;
 426         while (<F>) { $diff++,last if $_ ne <T>; }
 427         $diff++ unless eof(T);
 428         close T;
 429     }
 430     else { $diff++; }
 431     close F;
 432     if ($diff) {
 433         if (-e $to) {
 434             unlink($to) or confess "unlink $to: $!";
 435         }
 436       STRICT_SWITCH: {
 437             best($from,$to), last STRICT_SWITCH if $how eq 'best';
 438             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 439             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 440             croak("ExtUtils::Manifest::cp_if_diff " .
 441                   "called with illegal how argument [$how]. " .
 442                   "Legal values are 'best', 'cp', and 'ln'.");
 443         }
 444     }
 445 }
 446
 447 sub cp {
 448     my ($srcFile, $dstFile) = @_;
 449     my ($access,$mod) = (stat $srcFile)[8,9];
 450
 451     copy($srcFile,$dstFile);
 452     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 453     _manicopy_chmod($dstFile);
 454 }
 455
 456
 457 sub ln {
 458     my ($srcFile, $dstFile) = @_;
 459     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
 460     link($srcFile, $dstFile);
 461
 462     unless( _manicopy_chmod($dstFile) ) {
 463         unlink $dstFile;
 464         return;
 465     }
 466     1;
 467 }
 468
 469 # 1) Strip off all group and world permissions.
 470 # 2) Let everyone read it.
 471 # 3) If the owner can execute it, everyone can.
 472 sub _manicopy_chmod {
 473     my($file) = shift;
 474
 475     my $perm = 0444 | (stat $file)[2] & 0700;
 476     chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $file );
 477 }
 478
 479 sub best {
 480     my ($srcFile, $dstFile) = @_;
 481     if (!$Config{d_link} or -l $srcFile) {
 482         cp($srcFile, $dstFile);
 483     } else {
 484         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
 485     }
 486 }
 487
 488 sub _macify {
 489     my($file) = @_;
 490
 491     return $file unless $Is_MacOS;
 492
 493     $file =~ s|^\./||;
 494     if ($file =~ m|/|) {
 495         $file =~ s|/+|:|g;
 496         $file = ":$file";
 497     }
 498
 499     $file;
 500 }
 501
 502 sub _maccat {
 503     my($f1, $f2) = @_;
 504
 505     return "$f1/$f2" unless $Is_MacOS;
 506
 507     $f1 .= ":$f2";
 508     $f1 =~ s/([^:]:):/$1/g;
 509     return $f1;
 510 }
 511
 512 sub _unmacify {
 513     my($file) = @_;
 514
 515     return $file unless $Is_MacOS;
 516
 517     $file =~ s|^:||;
 518     $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
 519     $file =~ y|:|/|;
 520
 521     $file;
 522 }
 523
 524
 525 =item maniadd
 526
 527   maniadd({ $file => $comment, ...});
 528
 529 Adds an entry to an existing F<MANIFEST> unless its already there.
 530
 531 $file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
 532
 533 =cut
 534
 535 sub maniadd {
 536     my($additions) = shift;
 537
 538     _normalize($additions);
 539     _fix_manifest($MANIFEST);
 540
 541     my $manifest = maniread();
 542     my @needed = grep { !exists $manifest->{$_} } keys %$additions;
 543     return 1 unless @needed;
 544
 545     open(MANIFEST, ">>$MANIFEST") or
 546       die "maniadd() could not open $MANIFEST: $!";
 547
 548     foreach my $file (_sort @needed) {
 549         my $comment = $additions->{$file} || '';
 550         printf MANIFEST "%-40s %s\n", $file, $comment;
 551     }
 552     close MANIFEST or die "Error closing $MANIFEST: $!";
 553
 554     return 1;
 555 }
 556
 557
 558 # Sometimes MANIFESTs are missing a trailing newline.  Fix this.
 559 sub _fix_manifest {
 560     my $manifest_file = shift;
 561
 562     open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
 563
 564     # Yes, we should be using seek(), but I'd like to avoid loading POSIX
 565     # to get SEEK_*
 566     my @manifest = <MANIFEST>;
 567     close MANIFEST;
 568
 569     unless( $manifest[-1] =~ /\n\z/ ) {
 570         open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
 571         print MANIFEST "\n";
 572         close MANIFEST;
 573     }
 574 }
 575
 576
 577 # UNIMPLEMENTED
 578 sub _normalize {
 579     return;
 580 }
 581
 582
 583 =back
 584
 585 =head2 MANIFEST
 586
 587 Anything between white space and an end of line within a C<MANIFEST>
 588 file is considered to be a comment.  Filenames and comments are
 589 separated by one or more TAB characters in the output.
 590
 591
 592 =head2 MANIFEST.SKIP
 593
 594 The file MANIFEST.SKIP may contain regular expressions of files that
 595 should be ignored by mkmanifest() and filecheck(). The regular
 596 expressions should appear one on each line. Blank lines and lines
 597 which start with C<#> are skipped.  Use C<\#> if you need a regular
 598 expression to start with a sharp character. A typical example:
 599
 600     # Version control files and dirs.
 601     \bRCS\b
 602     \bCVS\b
 603     ,v$
 604     \B\.svn\b
 605
 606     # Makemaker generated files and dirs.
 607     ^MANIFEST\.
 608     ^Makefile$
 609     ^blib/
 610     ^MakeMaker-\d
 611
 612     # Temp, old and emacs backup files.
 613     ~$
 614     \.old$
 615     ^#.*#$
 616     ^\.#
 617
 618 If no MANIFEST.SKIP file is found, a default set of skips will be
 619 used, similar to the example above.  If you want nothing skipped,
 620 simply make an empty MANIFEST.SKIP file.
 621
 622
 623 =head2 EXPORT_OK
 624
 625 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 626 C<&maniread>, and C<&manicopy> are exportable.
 627
 628 =head2 GLOBAL VARIABLES
 629
 630 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 631 results in both a different C<MANIFEST> and a different
 632 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 633 different distributions for different audiences (say a user version
 634 and a developer version including RCS).
 635
 636 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 637 all functions act silently.
 638
 639 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
 640 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
 641 produced.
 642
 643 =head1 DIAGNOSTICS
 644
 645 All diagnostic output is sent to C<STDERR>.
 646
 647 =over 4
 648
 649 =item C<Not in MANIFEST:> I<file>
 650
 651 is reported if a file is found which is not in C<MANIFEST>.
 652
 653 =item C<Skipping> I<file>
 654
 655 is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
 656
 657 =item C<No such file:> I<file>
 658
 659 is reported if a file mentioned in a C<MANIFEST> file does not
 660 exist.
 661
 662 =item C<MANIFEST:> I<$!>
 663
 664 is reported if C<MANIFEST> could not be opened.
 665
 666 =item C<Added to MANIFEST:> I<file>
 667
 668 is reported by mkmanifest() if $Verbose is set and a file is added
 669 to MANIFEST. $Verbose is set to 1 by default.
 670
 671 =back
 672
 673 =head1 ENVIRONMENT
 674
 675 =over 4
 676
 677 =item B<PERL_MM_MANIFEST_DEBUG>
 678
 679 Turns on debugging
 680
 681 =back
 682
 683 =head1 SEE ALSO
 684
 685 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 686
 687 =head1 AUTHOR
 688
 689 Andreas Koenig C<andreas.koenig@anima.de>
 690
 691 Currently maintained by Michael G Schwern C<schwern@pobox.com>
 692
 693 =cut
 694
 695 1;