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.41;
  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 the HASH I<%$src> to the
 374 $dest_dir. The HASH reference $read is typically returned by the
 375 maniread() function. This function is useful for producing a directory
 376 tree identical to the intended distribution tree. The third parameter
 377 $how can be used to specify a different methods of "copying". Valid
 378 values are C<cp>, which actually copies the files, C<ln> which creates
 379 hard links, and C<best> which mostly links the files but copies any
 380 symbolic link to make a tree without any symbolic link. Best is the
 381 default.
 382
 383 =cut
 384
 385 sub manicopy {
 386     my($read,$target,$how)=@_;
 387     croak "manicopy() called without target argument" unless defined $target;
 388     $how ||= 'cp';
 389     require File::Path;
 390     require File::Basename;
 391
 392     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 393     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
 394     foreach my $file (keys %$read){
 395         if ($Is_MacOS) {
 396             if ($file =~ m!:!) {
 397                 my $dir = _maccat($target, $file);
 398                 $dir =~ s/[^:]+$//;
 399                 File::Path::mkpath($dir,1,0755);
 400             }
 401             cp_if_diff($file, _maccat($target, $file), $how);
 402         } else {
 403             $file = VMS::Filespec::unixify($file) if $Is_VMS;
 404             if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 405                 my $dir = File::Basename::dirname($file);
 406                 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 407                 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
 408             }
 409             cp_if_diff($file, "$target/$file", $how);
 410         }
 411     }
 412 }
 413
 414 sub cp_if_diff {
 415     my($from, $to, $how)=@_;
 416     -f $from or carp "$0: $from not found";
 417     my($diff) = 0;
 418     local(*F,*T);
 419     open(F,"< $from\0") or die "Can't read $from: $!\n";
 420     if (open(T,"< $to\0")) {
 421         local $_;
 422         while (<F>) { $diff++,last if $_ ne <T>; }
 423         $diff++ unless eof(T);
 424         close T;
 425     }
 426     else { $diff++; }
 427     close F;
 428     if ($diff) {
 429         if (-e $to) {
 430             unlink($to) or confess "unlink $to: $!";
 431         }
 432       STRICT_SWITCH: {
 433             best($from,$to), last STRICT_SWITCH if $how eq 'best';
 434             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 435             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 436             croak("ExtUtils::Manifest::cp_if_diff " .
 437                   "called with illegal how argument [$how]. " .
 438                   "Legal values are 'best', 'cp', and 'ln'.");
 439         }
 440     }
 441 }
 442
 443 sub cp {
 444     my ($srcFile, $dstFile) = @_;
 445     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
 446     copy($srcFile,$dstFile);
 447     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 448     # chmod a+rX-w,go-w
 449     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile )
 450       unless ($^O eq 'MacOS');
 451 }
 452
 453 sub ln {
 454     my ($srcFile, $dstFile) = @_;
 455     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
 456     link($srcFile, $dstFile);
 457
 458     # chmod a+r,go-w+X (except "X" only applies to u=x)
 459     local($_) = $dstFile;
 460     my $mode= 0444 | (stat)[2] & 0700;
 461     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
 462         unlink $dstFile;
 463         return;
 464     }
 465     1;
 466 }
 467
 468 unless (defined $Config{d_link}) {
 469     # Really cool fix from Ilya :)
 470     local $SIG{__WARN__} = sub {
 471         warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
 472     };
 473     *ln = \&cp;
 474 }
 475
 476
 477
 478
 479 sub best {
 480     my ($srcFile, $dstFile) = @_;
 481     if (-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 $is_open;
 543     foreach my $file (_sort keys %$additions) {
 544         next if exists $manifest->{$file};
 545
 546         $is_open++ or open(MANIFEST, ">>$MANIFEST") or
 547           die "Could not open $MANIFEST: $!";
 548
 549         my $comment = $additions->{$file} || '';
 550         printf MANIFEST "%-40s%s\n", $file, $comment;
 551     }
 552     close MANIFEST if $is_open;
 553 }
 554
 555
 556 # Sometimes MANIFESTs are missing a trailing newline.  Fix this.
 557 sub _fix_manifest {
 558     my $manifest_file = shift;
 559
 560     open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
 561
 562     # Yes, we should be using seek(), but I'd like to avoid loading POSIX
 563     # to get SEEK_*
 564     my @manifest = <MANIFEST>;
 565     close MANIFEST;
 566
 567     unless( $manifest[-1] =~ /\n\z/ ) {
 568         open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
 569         print MANIFEST "\n";
 570         close MANIFEST;
 571     }
 572 }
 573
 574
 575 # UNIMPLEMENTED
 576 sub _normalize {
 577     return;
 578 }
 579
 580
 581 =back
 582
 583 =head2 MANIFEST
 584
 585 Anything between white space and an end of line within a C<MANIFEST>
 586 file is considered to be a comment.  Filenames and comments are
 587 separated by one or more TAB characters in the output.
 588
 589
 590 =head2 MANIFEST.SKIP
 591
 592 The file MANIFEST.SKIP may contain regular expressions of files that
 593 should be ignored by mkmanifest() and filecheck(). The regular
 594 expressions should appear one on each line. Blank lines and lines
 595 which start with C<#> are skipped.  Use C<\#> if you need a regular
 596 expression to start with a sharp character. A typical example:
 597
 598     # Version control files and dirs.
 599     \bRCS\b
 600     \bCVS\b
 601     ,v$
 602     \B\.svn\b
 603
 604     # Makemaker generated files and dirs.
 605     ^MANIFEST\.
 606     ^Makefile$
 607     ^blib/
 608     ^MakeMaker-\d
 609
 610     # Temp, old and emacs backup files.
 611     ~$
 612     \.old$
 613     ^#.*#$
 614     ^\.#
 615
 616 If no MANIFEST.SKIP file is found, a default set of skips will be
 617 used, similar to the example above.  If you want nothing skipped,
 618 simply make an empty MANIFEST.SKIP file.
 619
 620
 621 =head2 EXPORT_OK
 622
 623 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 624 C<&maniread>, and C<&manicopy> are exportable.
 625
 626 =head2 GLOBAL VARIABLES
 627
 628 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 629 results in both a different C<MANIFEST> and a different
 630 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 631 different distributions for different audiences (say a user version
 632 and a developer version including RCS).
 633
 634 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 635 all functions act silently.
 636
 637 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
 638 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
 639 produced.
 640
 641 =head1 DIAGNOSTICS
 642
 643 All diagnostic output is sent to C<STDERR>.
 644
 645 =over 4
 646
 647 =item C<Not in MANIFEST:> I<file>
 648
 649 is reported if a file is found which is not in C<MANIFEST>.
 650
 651 =item C<Skipping> I<file>
 652
 653 is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
 654
 655 =item C<No such file:> I<file>
 656
 657 is reported if a file mentioned in a C<MANIFEST> file does not
 658 exist.
 659
 660 =item C<MANIFEST:> I<$!>
 661
 662 is reported if C<MANIFEST> could not be opened.
 663
 664 =item C<Added to MANIFEST:> I<file>
 665
 666 is reported by mkmanifest() if $Verbose is set and a file is added
 667 to MANIFEST. $Verbose is set to 1 by default.
 668
 669 =back
 670
 671 =head1 ENVIRONMENT
 672
 673 =over 4
 674
 675 =item B<PERL_MM_MANIFEST_DEBUG>
 676
 677 Turns on debugging
 678
 679 =back
 680
 681 =head1 SEE ALSO
 682
 683 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 684
 685 =head1 AUTHOR
 686
 687 Andreas Koenig <F<andreas.koenig@anima.de>>
 688
 689 =cut
 690
 691 1;