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