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 = 1.35_00;
  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 current
 365 directory really do exist. If C<MANIFEST> and the tree below the current
 366 directory are in sync it exits silently, returning an empty list.  Otherwise
 367 it returns a list of files which are listed in the C<MANIFEST> but missing
 368 from the directory, and by default also outputs these names to STDERR.
 369
 370 filecheck() finds files below the current directory that are not
 371 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
 372 will be consulted. Any file matching a regular expression in such a
 373 file will not be reported as missing in the C<MANIFEST> file. The list of
 374 any extraneous files found is returned, and by default also reported to
 375 STDERR.
 376
 377 fullcheck() does both a manicheck() and a filecheck(), returning references
 378 to two arrays, the first for files manicheck() found to be missing, the
 379 seond for unexpeced files found by filecheck().
 380
 381 skipcheck() lists all the files that are skipped due to your
 382 C<MANIFEST.SKIP> file.
 383
 384 manifind() returns a hash reference. The keys of the hash are the
 385 files found below the current directory.
 386
 387 maniread($file) reads a named C<MANIFEST> file (defaults to
 388 C<MANIFEST> in the current directory) and returns a HASH reference
 389 with files being the keys and comments being the values of the HASH.
 390 Blank lines and lines which start with C<#> in the C<MANIFEST> file
 391 are discarded.
 392
 393 C<manicopy($read,$target,$how)> copies the files that are the keys in
 394 the HASH I<%$read> to the named target directory. The HASH reference
 395 $read is typically returned by the maniread() function. This
 396 function is useful for producing a directory tree identical to the
 397 intended distribution tree. The third parameter $how can be used to
 398 specify a different methods of "copying". Valid values are C<cp>,
 399 which actually copies the files, C<ln> which creates hard links, and
 400 C<best> which mostly links the files but copies any symbolic link to
 401 make a tree without any symbolic link. Best is the default.
 402
 403 =head1 MANIFEST.SKIP
 404
 405 The file MANIFEST.SKIP may contain regular expressions of files that
 406 should be ignored by mkmanifest() and filecheck(). The regular
 407 expressions should appear one on each line. Blank lines and lines
 408 which start with C<#> are skipped.  Use C<\#> if you need a regular
 409 expression to start with a sharp character. A typical example:
 410
 411     # Version control files and dirs.
 412     \bRCS\b
 413     \bCVS\b
 414     ,v$
 415
 416     # Makemaker generated files and dirs.
 417     ^MANIFEST\.
 418     ^Makefile$
 419     ^blib/
 420     ^MakeMaker-\d
 421
 422     # Temp, old and emacs backup files.
 423     ~$
 424     \.old$
 425     ^#.*#$
 426     ^\.#
 427
 428 If no MANIFEST.SKIP file is found, a default set of skips will be
 429 used, similar to the example above.  If you want nothing skipped,
 430 simply make an empty MANIFEST.SKIP file.
 431
 432
 433 =head1 EXPORT_OK
 434
 435 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 436 C<&maniread>, and C<&manicopy> are exportable.
 437
 438 =head1 GLOBAL VARIABLES
 439
 440 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 441 results in both a different C<MANIFEST> and a different
 442 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 443 different distributions for different audiences (say a user version
 444 and a developer version including RCS).
 445
 446 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 447 all functions act silently.
 448
 449 C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
 450 or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
 451 produced.
 452
 453 =head1 DIAGNOSTICS
 454
 455 All diagnostic output is sent to C<STDERR>.
 456
 457 =over 4
 458
 459 =item C<Not in MANIFEST:> I<file>
 460
 461 is reported if a file is found, that is missing in the C<MANIFEST>
 462 file which is excluded by a regular expression in the file
 463 C<MANIFEST.SKIP>.
 464
 465 =item C<No such file:> I<file>
 466
 467 is reported if a file mentioned in a C<MANIFEST> file does not
 468 exist.
 469
 470 =item C<MANIFEST:> I<$!>
 471
 472 is reported if C<MANIFEST> could not be opened.
 473
 474 =item C<Added to MANIFEST:> I<file>
 475
 476 is reported by mkmanifest() if $Verbose is set and a file is added
 477 to MANIFEST. $Verbose is set to 1 by default.
 478
 479 =back
 480
 481 =head1 ENVIRONMENT
 482
 483 =over 4
 484
 485 =item B<PERL_MM_MANIFEST_DEBUG>
 486
 487 Turns on debugging
 488
 489 =back
 490
 491 =head1 SEE ALSO
 492
 493 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 494
 495 =head1 AUTHOR
 496
 497 Andreas Koenig <F<andreas.koenig@anima.de>>
 498
 499 =cut