lib/ExtUtils/Manifest.pm

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