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,$DEFAULT_MSKIP);
+use vars qw($VERSION @ISA @EXPORT_OK
+ $Is_MacOS $Is_VMS
+ $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
-$VERSION = 1.37_01;
+$VERSION = 1.38;
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
'skipcheck', 'maniread', 'manicopy');
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;
sub manifind {
my $p = shift || {};
- my $skip = _maniskip(warn => $p->{warn_on_skip});
my $found = {};
my $wanted = sub {
my $name = clean_up_filename($File::Find::name);
warn "Debug: diskfile $name\n" if $Debug;
- return if $skip->($name) or -d $name;
+ return if -d $_;
if( $Is_VMS ) {
$name =~ s#(.*)\.$#\L$1#;
# $File::Find::name is unavailable.
# Also, it's okay to use / here, because MANIFEST files use Unix-style
# paths.
- find({wanted => $wanted,
- preprocess =>
- sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
- no_chdir => 1,
- },
+ 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});
+ my($p) = @_;
+ my $found = manifind();
+ 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 _manicheck {
- my($p) = @_;
- my $read = maniread();
- my $found = manifind($p);
- my $file;
+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;
# returns an anonymous sub that decides if an argument matches
sub _maniskip {
- my (%args) = @_;
-
my @skip ;
- my $mfile ||= "$MANIFEST.SKIP";
+ my $mfile = "$MANIFEST.SKIP";
local *M;
open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
while (<M>){
# any of them contain alternations
my $regex = join '|', map "(?:$_)", @skip;
- return ($args{warn}
- ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
- : sub { $_[0] =~ qr{$opts$regex} }
- );
+ return sub { $_[0] =~ qr{$opts$regex} };
}
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);
-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 (<F>) { $diff++,last if $_ ne <T>; }
$diff++ unless eof(T);
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) {
=item C<Not in MANIFEST:> I<file>
-is reported if a file is found, that is missing in the C<MANIFEST>
-file which is excluded by a regular expression in the file
-C<MANIFEST.SKIP>.
+is reported if a file is found which is not in C<MANIFEST>.
+
+=item C<Skipping> I<file>
+
+is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
=item C<No such file:> I<file>
projects / p5sagit/p5-mst-13.2.git / blobdiff