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