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