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