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