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.39;
  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 exits silently, returning 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     while (<M>){
 316         chomp;
 317         next if /^#/;
 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         next if /^#/;
 354         next if /^\s*$/;
 355         push @skip, _macify($_);
 356     }
 357     close M;
 358     my $opts = $Is_VMS ? '(?i)' : '';
 359
 360     # Make sure each entry is isolated in its own parentheses, in case
 361     # any of them contain alternations
 362     my $regex = join '|', map "(?:$_)", @skip;
 363
 364     return sub { $_[0] =~ qr{$opts$regex} };
 365 }
 366
 367 =item manicopy
 368
 369     manicopy($src, $dest_dir);
 370     manicopy($src, $dest_dir, $how);
 371
 372 copies the files that are the keys in the HASH I<%$src> to the
 373 $dest_dir. The HASH reference $read is typically returned by the
 374 maniread() function. This function is useful for producing a directory
 375 tree identical to the intended distribution tree. The third parameter
 376 $how can be used to specify a different methods of "copying". Valid
 377 values are C<cp>, which actually copies the files, C<ln> which creates
 378 hard links, and C<best> which mostly links the files but copies any
 379 symbolic link to make a tree without any symbolic link. Best is the
 380 default.
 381
 382 =cut
 383
 384 sub manicopy {
 385     my($read,$target,$how)=@_;
 386     croak "manicopy() called without target argument" unless defined $target;
 387     $how ||= 'cp';
 388     require File::Path;
 389     require File::Basename;
 390
 391     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 392     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
 393     foreach my $file (keys %$read){
 394         if ($Is_MacOS) {
 395             if ($file =~ m!:!) {
 396                 my $dir = _maccat($target, $file);
 397                 $dir =~ s/[^:]+$//;
 398                 File::Path::mkpath($dir,1,0755);
 399             }
 400             cp_if_diff($file, _maccat($target, $file), $how);
 401         } else {
 402             $file = VMS::Filespec::unixify($file) if $Is_VMS;
 403             if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 404                 my $dir = File::Basename::dirname($file);
 405                 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 406                 File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
 407             }
 408             cp_if_diff($file, "$target/$file", $how);
 409         }
 410     }
 411 }
 412
 413 sub cp_if_diff {
 414     my($from, $to, $how)=@_;
 415     -f $from or carp "$0: $from not found";
 416     my($diff) = 0;
 417     local(*F,*T);
 418     open(F,"< $from\0") or die "Can't read $from: $!\n";
 419     if (open(T,"< $to\0")) {
 420         while (<F>) { $diff++,last if $_ ne <T>; }
 421         $diff++ unless eof(T);
 422         close T;
 423     }
 424     else { $diff++; }
 425     close F;
 426     if ($diff) {
 427         if (-e $to) {
 428             unlink($to) or confess "unlink $to: $!";
 429         }
 430       STRICT_SWITCH: {
 431             best($from,$to), last STRICT_SWITCH if $how eq 'best';
 432             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 433             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 434             croak("ExtUtils::Manifest::cp_if_diff " .
 435                   "called with illegal how argument [$how]. " .
 436                   "Legal values are 'best', 'cp', and 'ln'.");
 437         }
 438     }
 439 }
 440
 441 sub cp {
 442     my ($srcFile, $dstFile) = @_;
 443     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
 444     copy($srcFile,$dstFile);
 445     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 446     # chmod a+rX-w,go-w
 447     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile )
 448       unless ($^O eq 'MacOS');
 449 }
 450
 451 sub ln {
 452     my ($srcFile, $dstFile) = @_;
 453     return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
 454     link($srcFile, $dstFile);
 455
 456     # chmod a+r,go-w+X (except "X" only applies to u=x)
 457     local($_) = $dstFile;
 458     my $mode= 0444 | (stat)[2] & 0700;
 459     if (! chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  )) {
 460         unlink $dstFile;
 461         return;
 462     }
 463     1;
 464 }
 465
 466 unless (defined $Config{d_link}) {
 467     # Really cool fix from Ilya :)
 468     local $SIG{__WARN__} = sub {
 469         warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
 470     };
 471     *ln = \&cp;
 472 }
 473
 474
 475
 476
 477 sub best {
 478     my ($srcFile, $dstFile) = @_;
 479     if (-l $srcFile) {
 480         cp($srcFile, $dstFile);
 481     } else {
 482         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
 483     }
 484 }
 485
 486 sub _macify {
 487     my($file) = @_;
 488
 489     return $file unless $Is_MacOS;
 490
 491     $file =~ s|^\./||;
 492     if ($file =~ m|/|) {
 493         $file =~ s|/+|:|g;
 494         $file = ":$file";
 495     }
 496
 497     $file;
 498 }
 499
 500 sub _maccat {
 501     my($f1, $f2) = @_;
 502
 503     return "$f1/$f2" unless $Is_MacOS;
 504
 505     $f1 .= ":$f2";
 506     $f1 =~ s/([^:]:):/$1/g;
 507     return $f1;
 508 }
 509
 510 sub _unmacify {
 511     my($file) = @_;
 512
 513     return $file unless $Is_MacOS;
 514
 515     $file =~ s|^:||;
 516     $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
 517     $file =~ y|:|/|;
 518
 519     $file;
 520 }
 521
 522
 523 =item maniadd
 524
 525   maniadd({ $file => $comment, ...});
 526
 527 Adds an entry to an existing F<MANIFEST>.
 528
 529 $file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
 530
 531 =cut
 532
 533 sub maniadd {
 534     my($additions) = shift;
 535
 536     _normalize($additions);
 537
 538     my $manifest = maniread();
 539     open(MANIFEST, ">>$MANIFEST") or die "Could not open $MANIFEST: $!";
 540     foreach my $file (_sort keys %$additions) {
 541         my $comment = $additions->{$file} || '';
 542         printf MANIFEST "%-40s%s\n", $file, $comment unless
 543           exists $manifest->{$file};
 544     }
 545     close MANIFEST;
 546 }
 547
 548 # UNIMPLEMENTED
 549 sub _normalize {
 550     return;
 551 }
 552
 553
 554 =back
 555
 556 =head2 MANIFEST
 557
 558 Anything between white space and an end of line within a C<MANIFEST>
 559 file is considered to be a comment.  Filenames and comments are
 560 separated by one or more TAB characters in the output.
 561
 562
 563 =head2 MANIFEST.SKIP
 564
 565 The file MANIFEST.SKIP may contain regular expressions of files that
 566 should be ignored by mkmanifest() and filecheck(). The regular
 567 expressions should appear one on each line. Blank lines and lines
 568 which start with C<#> are skipped.  Use C<\#> if you need a regular
 569 expression to start with a sharp character. A typical example:
 570
 571     # Version control files and dirs.
 572     \bRCS\b
 573     \bCVS\b
 574     ,v$
 575     \B\.svn\b
 576
 577     # Makemaker generated files and dirs.
 578     ^MANIFEST\.
 579     ^Makefile$
 580     ^blib/
 581     ^MakeMaker-\d
 582
 583     # Temp, old and emacs backup files.
 584     ~$
 585     \.old$
 586     ^#.*#$
 587     ^\.#
 588
 589 If no MANIFEST.SKIP file is found, a default set of skips will be
 590 used, similar to the example above.  If you want nothing skipped,
 591 simply make an empty MANIFEST.SKIP file.
 592
 593
 594 =head2 EXPORT_OK
 595
 596 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 597 C<&maniread>, and C<&manicopy> are exportable.
 598
 599 =head2 GLOBAL VARIABLES
 600
 601 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 602 results in both a different C<MANIFEST> and a different
 603 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 604 different distributions for different audiences (say a user version
 605 and a developer version including RCS).
 606
 607 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 608 all functions act silently.
 609
 610 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
 611 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
 612 produced.
 613
 614 =head1 DIAGNOSTICS
 615
 616 All diagnostic output is sent to C<STDERR>.
 617
 618 =over 4
 619
 620 =item C<Not in MANIFEST:> I<file>
 621
 622 is reported if a file is found which is not in C<MANIFEST>.
 623
 624 =item C<Skipping> I<file>
 625
 626 is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
 627
 628 =item C<No such file:> I<file>
 629
 630 is reported if a file mentioned in a C<MANIFEST> file does not
 631 exist.
 632
 633 =item C<MANIFEST:> I<$!>
 634
 635 is reported if C<MANIFEST> could not be opened.
 636
 637 =item C<Added to MANIFEST:> I<file>
 638
 639 is reported by mkmanifest() if $Verbose is set and a file is added
 640 to MANIFEST. $Verbose is set to 1 by default.
 641
 642 =back
 643
 644 =head1 ENVIRONMENT
 645
 646 =over 4
 647
 648 =item B<PERL_MM_MANIFEST_DEBUG>
 649
 650 Turns on debugging
 651
 652 =back
 653
 654 =head1 SEE ALSO
 655
 656 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 657
 658 =head1 AUTHOR
 659
 660 Andreas Koenig <F<andreas.koenig@anima.de>>
 661
 662 =cut
 663
 664 1;