X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FManifest.pm;h=7ca5bdd3726e4c8de823b2ecf0e00981fa9ad6f8;hb=69ff8adf802894e0957dae2b89f4e2c30fa38e90;hp=eee57d2c6fc7e6f040ab902cb70fd486a0140327;hpb=39234879f5d0d01795f6b444c84aeec3481bcd99;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index eee57d2..7ca5bdd 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -4,34 +4,30 @@ require Exporter; use Config; use File::Find; use File::Copy 'copy'; -use File::Spec::Functions qw(splitpath); +use File::Spec; use Carp; use strict; -our ($VERSION,@ISA,@EXPORT_OK, - $Is_MacOS,$Is_VMS, - $Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP); +use vars qw($VERSION @ISA @EXPORT_OK + $Is_MacOS $Is_VMS + $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP); -$VERSION = 1.35_00; +$VERSION = 1.38; @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); $Is_MacOS = $^O eq 'MacOS'; $Is_VMS = $^O eq 'VMS'; -if ($Is_VMS) { require File::Basename } +require VMS::Filespec if $Is_VMS; $Debug = $ENV{PERL_MM_MANIFEST_DEBUG} || 0; -$Verbose = 1; +$Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? + $ENV{PERL_MM_MANIFEST_VERBOSE} : 1; $Quiet = 0; $MANIFEST = 'MANIFEST'; -$DEFAULT_MSKIP = (splitpath($INC{"ExtUtils/Manifest.pm"}))[1]."$MANIFEST.SKIP"; - -# Really cool fix from Ilya :) -unless (defined $Config{d_link}) { - no warnings; - *ln = \&cp; -} +$DEFAULT_MSKIP = (File::Spec->splitpath($INC{"ExtUtils/Manifest.pm"}))[1]. + "$MANIFEST.SKIP"; sub mkmanifest { my $manimiss = 0; @@ -40,14 +36,19 @@ sub mkmanifest { local *M; rename $MANIFEST, "$MANIFEST.bak" unless $manimiss; open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!"; - my $matches = _maniskip(); + my $skip = _maniskip(); my $found = manifind(); my($key,$val,$file,%all); %all = (%$found, %$read); $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files' if $manimiss; # add new MANIFEST to known file list foreach $file (sort keys %all) { - next if &$matches($file); + if ($skip->($file)) { + # Policy: only remove files if they're listed in MANIFEST.SKIP. + # Don't remove files just because they don't exist. + warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file}; + next; + } if ($Verbose){ warn "Added to $MANIFEST: $file\n" unless exists $read->{$file}; } @@ -62,74 +63,116 @@ sub mkmanifest { close M; } +# Geez, shouldn't this use File::Spec or File::Basename or something? +# Why so careful about dependencies? +sub clean_up_filename { + my $filename = shift; + $filename =~ s|^\./||; + $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS; + return $filename; +} + sub manifind { - local $found = {}; - find(sub {return if -d $_; - (my $name = $File::Find::name) =~ s|^\./||; - $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS; - warn "Debug: diskfile $name\n" if $Debug; - $name =~ s#(.*)\.$#\L$1# if $Is_VMS; - $name = uc($name) if /^MANIFEST/i && $Is_VMS; - $found->{$name} = "";}, $Is_MacOS ? ":" : "."); - $found; + my $p = shift || {}; + my $found = {}; + + my $wanted = sub { + my $name = clean_up_filename($File::Find::name); + warn "Debug: diskfile $name\n" if $Debug; + return if -d $_; + + if( $Is_VMS ) { + $name =~ s#(.*)\.$#\L$1#; + $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i; + } + $found->{$name} = ""; + }; + + # We have to use "$File::Find::dir/$_" in preprocess, because + # $File::Find::name is unavailable. + # Also, it's okay to use / here, because MANIFEST files use Unix-style + # paths. + find({wanted => $wanted}, + $Is_MacOS ? ":" : "."); + + return $found; } sub fullcheck { - _manicheck({check_files => 1, check_MANIFEST => 1}); + return [_check_files()], [_check_manifest()]; } sub manicheck { - return @{(_manicheck({check_files => 1}))[0]}; + return _check_files(); } sub filecheck { - return @{(_manicheck({check_MANIFEST => 1}))[1]}; + return _check_manifest(); } sub skipcheck { - _manicheck({check_MANIFEST => 1, warn_on_skip => 1}); -} - -sub _manicheck { my($p) = @_; - my $read = maniread(); my $found = manifind(); - my $file; + my $matches = _maniskip(); + + my @skipped = (); + foreach my $file (sort keys %$found){ + if (&$matches($file)){ + warn "Skipping $file\n"; + push @skipped, $file; + next; + } + } + + return @skipped; +} + + +sub _check_files { + my $p = shift; my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0); - my(@missfile,@missentry); - if ($p->{check_files}){ - foreach $file (sort keys %$read){ - warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; - if ($dosnames){ - $file = lc $file; - $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; - $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; - } - unless ( exists $found->{$file} ) { - warn "No such file: $file\n" unless $Quiet; - push @missfile, $file; - } - } + my $read = maniread() || {}; + my $found = manifind($p); + + my(@missfile) = (); + foreach my $file (sort keys %$read){ + warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug; + if ($dosnames){ + $file = lc $file; + $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge; + $file =~ s=((\w|-)+)=substr ($1,0,8)=ge; + } + unless ( exists $found->{$file} ) { + warn "No such file: $file\n" unless $Quiet; + push @missfile, $file; + } } - if ($p->{check_MANIFEST}){ - $read ||= {}; - my $matches = _maniskip(); - foreach $file (sort keys %$found){ - if (&$matches($file)){ - warn "Skipping $file\n" if $p->{warn_on_skip}; - next; - } - warn "Debug: manicheck checking from disk $file\n" if $Debug; - unless ( exists $read->{$file} ) { - my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; - warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; - push @missentry, $file; - } - } + + return @missfile; +} + + +sub _check_manifest { + my($p) = @_; + my $read = maniread() || {}; + my $found = manifind($p); + my $skip = _maniskip(); + + my @missentry = (); + foreach my $file (sort keys %$found){ + next if $skip->($file); + warn "Debug: manicheck checking from disk $file\n" if $Debug; + unless ( exists $read->{$file} ) { + my $canon = $Is_MacOS ? "\t" . _unmacify($file) : ''; + warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; + push @missentry, $file; + } } - (\@missfile,\@missentry); + + return @missentry; } + sub maniread { my ($mfile) = @_; $mfile ||= $MANIFEST; @@ -151,6 +194,7 @@ sub maniread { $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge; } elsif ($Is_VMS) { + require File::Basename; my($base,$dir) = File::Basename::fileparse($file); # Resolve illegal file specifications in the same way as tar $dir =~ tr/./_/; @@ -159,7 +203,7 @@ sub maniread { my $okfile = "$dir$base"; warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; $file = $okfile; - $file = lc($file) unless $file =~ /^MANIFEST/i; + $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/; } $read->{$file} = $comment; @@ -170,12 +214,10 @@ sub maniread { # returns an anonymous sub that decides if an argument matches sub _maniskip { - my ($mfile) = @_; - my $matches = sub {0}; my @skip ; - $mfile ||= "$MANIFEST.SKIP"; + my $mfile = "$MANIFEST.SKIP"; local *M; - open M, $mfile or open M, $DEFAULT_MSKIP or return $matches; + open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0}; while (){ chomp; next if /^#/; @@ -183,14 +225,13 @@ sub _maniskip { push @skip, _macify($_); } close M; - my $opts = $Is_VMS ? 'oi ' : 'o '; - my $sub = "\$matches = " - . "sub { my(\$arg)=\@_; return 1 if " - . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0) - . " }"; - eval $sub; - print "Debug: $sub\n" if $Debug; - $matches; + my $opts = $Is_VMS ? '(?i)' : ''; + + # Make sure each entry is isolated in its own parentheses, in case + # any of them contain alternations + my $regex = join '|', map "(?:$_)", @skip; + + return sub { $_[0] =~ qr{$opts$regex} }; } sub manicopy { @@ -199,10 +240,10 @@ sub manicopy { $how ||= 'cp'; require File::Path; require File::Basename; - my(%dirs,$file); + $target = VMS::Filespec::unixify($target) if $Is_VMS; File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); - foreach $file (keys %$read){ + foreach my $file (keys %$read){ if ($Is_MacOS) { if ($file =~ m!:!) { my $dir = _maccat($target, $file); @@ -227,7 +268,7 @@ sub cp_if_diff { -f $from or carp "$0: $from not found"; my($diff) = 0; local(*F,*T); - open(F,"< $from\0") or croak "Can't read $from: $!\n"; + open(F,"< $from\0") or die "Can't read $from: $!\n"; if (open(T,"< $to\0")) { while () { $diff++,last if $_ ne ; } $diff++ unless eof(T); @@ -256,22 +297,36 @@ sub cp { copy($srcFile,$dstFile); utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; # chmod a+rX-w,go-w - chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS'); + chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) + unless ($^O eq 'MacOS'); } sub ln { my ($srcFile, $dstFile) = @_; return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); link($srcFile, $dstFile); - local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x) + + # chmod a+r,go-w+X (except "X" only applies to u=x) + local($_) = $dstFile; my $mode= 0444 | (stat)[2] & 0700; if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) { - unlink $dstFile; - return; + unlink $dstFile; + return; } 1; } +unless (defined $Config{d_link}) { + # Really cool fix from Ilya :) + local $SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Subroutine .* redefined/; + }; + *ln = \&cp; +} + + + + sub best { my ($srcFile, $dstFile) = @_; if (-l $srcFile) { @@ -361,17 +416,22 @@ comments are separated by one or more TAB characters in the output. All files that match any regular expression in a file C (if such a file exists) are ignored. -manicheck() checks if all the files within a C in the -current directory really do exist. It only reports discrepancies and -exits silently if MANIFEST and the tree below the current directory -are in sync. +manicheck() checks if all the files within a C in the current +directory really do exist. If C and the tree below the current +directory are in sync it exits silently, returning an empty list. Otherwise +it returns a list of files which are listed in the C but missing +from the directory, and by default also outputs these names to STDERR. filecheck() finds files below the current directory that are not mentioned in the C file. An optional file C will be consulted. Any file matching a regular expression in such a -file will not be reported as missing in the C file. +file will not be reported as missing in the C file. The list of +any extraneous files found is returned, and by default also reported to +STDERR. -fullcheck() does both a manicheck() and a filecheck(). +fullcheck() does both a manicheck() and a filecheck(), returning references +to two arrays, the first for files manicheck() found to be missing, the +seond for unexpeced files found by filecheck(). skipcheck() lists all the files that are skipped due to your C file. @@ -453,9 +513,11 @@ All diagnostic output is sent to C. =item C I -is reported if a file is found, that is missing in the C -file which is excluded by a regular expression in the file -C. +is reported if a file is found which is not in C. + +=item C I + +is reported if a file is skipped due to an entry in C. =item C I