use strict;
our ($VERSION,@ISA,@EXPORT_OK,
- $Is_VMS,$Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP);
+ $Is_MacOS,$Is_VMS,
+ $Debug,$Verbose,$Quiet,$MANIFEST,$DEFAULT_MSKIP);
-$VERSION = substr(q$Revision: 1.33 $, 10);
+$VERSION = 1.37_01;
@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";
sub mkmanifest {
my $manimiss = 0;
- my $read = maniread() or $manimiss++;
+ my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
$read = {} if $manimiss;
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};
}
my $text = $all{$file};
($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
+ $file = _unmacify($file);
my $tabs = (5 - (length($file)+1)/8);
$tabs = 1 if $tabs < 1;
$tabs = 0 unless $text;
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|./||;
- warn "Debug: diskfile $name\n" if $Debug;
- $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
- $found->{$name} = "";}, ".");
- $found;
+ 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;
+
+ 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,
+ preprocess =>
+ sub {grep {!$skip->( clean_up_filename("$File::Find::dir/$_") )} @_},
+ no_chdir => 1,
+ },
+ $Is_MacOS ? ":" : ".");
+
+ return $found;
}
sub fullcheck {
- _manicheck(3);
+ _manicheck({check_files => 1, check_MANIFEST => 1});
}
sub manicheck {
- return @{(_manicheck(1))[0]};
+ return @{(_manicheck({check_files => 1}))[0]};
}
sub filecheck {
- return @{(_manicheck(2))[1]};
+ return @{(_manicheck({check_MANIFEST => 1}))[1]};
}
sub skipcheck {
- _manicheck(6);
+ _manicheck({check_MANIFEST => 1, warn_on_skip => 1});
}
sub _manicheck {
- my($arg) = @_;
+ my($p) = @_;
my $read = maniread();
- my $found = manifind();
+ my $found = manifind($p);
+
my $file;
my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
my(@missfile,@missentry);
- if ($arg & 1){
+ if ($p->{check_files}){
foreach $file (sort keys %$read){
warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
if ($dosnames){
}
}
}
- if ($arg & 2){
+ if ($p->{check_MANIFEST}){
$read ||= {};
my $matches = _maniskip();
- my $skipwarn = $arg & 4;
foreach $file (sort keys %$found){
if (&$matches($file)){
- warn "Skipping $file\n" if $skipwarn;
+ warn "Skipping $file\n" if $p->{warn_on_skip};
next;
}
warn "Debug: manicheck checking from disk $file\n" if $Debug;
unless ( exists $read->{$file} ) {
- warn "Not in $MANIFEST: $file\n" unless $Quiet;
+ my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
+ warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
push @missentry, $file;
}
}
while (<M>){
chomp;
next if /^#/;
- if ($Is_VMS) {
- my($file)= /^(\S+)/;
- next unless $file;
+
+ my($file, $comment) = /^(\S+)\s*(.*)/;
+ next unless $file;
+
+ if ($Is_MacOS) {
+ $file = _macify($file);
+ $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/./_/;
if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
my $okfile = "$dir$base";
warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
- $read->{"\L$okfile"}=$_;
+ $file = $okfile;
+ $file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
}
- else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+
+ $read->{$file} = $comment;
}
close M;
$read;
# returns an anonymous sub that decides if an argument matches
sub _maniskip {
- my ($mfile) = @_;
- my $matches = sub {0};
+ my (%args) = @_;
+
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 (<M>){
chomp;
next if /^#/;
next if /^\s*$/;
- push @skip, $_;
+ 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 ($args{warn}
+ ? sub { $_[0] =~ qr{$opts$regex} && warn "Skipping $_[0]\n" }
+ : sub { $_[0] =~ qr{$opts$regex} }
+ );
}
sub manicopy {
$target = VMS::Filespec::unixify($target) if $Is_VMS;
File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
foreach $file (keys %$read){
- $file = VMS::Filespec::unixify($file) if $Is_VMS;
- if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
- my $dir = File::Basename::dirname($file);
- $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
- File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
+ if ($Is_MacOS) {
+ if ($file =~ m!:!) {
+ my $dir = _maccat($target, $file);
+ $dir =~ s/[^:]+$//;
+ File::Path::mkpath($dir,1,0755);
+ }
+ cp_if_diff($file, _maccat($target, $file), $how);
+ } else {
+ $file = VMS::Filespec::unixify($file) if $Is_VMS;
+ if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
+ my $dir = File::Basename::dirname($file);
+ $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+ File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
+ }
+ cp_if_diff($file, "$target/$file", $how);
}
- cp_if_diff($file, "$target/$file", $how);
}
}
-f $from or carp "$0: $from not found";
my($diff) = 0;
local(*F,*T);
- open(F,$from) or croak "Can't read $from: $!\n";
- if (open(T,$to)) {
+ open(F,"< $from\0") or croak "Can't read $from: $!\n";
+ if (open(T,"< $to\0")) {
while (<F>) { $diff++,last if $_ ne <T>; }
$diff++ unless eof(T);
close 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 );
+ chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS');
}
sub ln {
}
}
+sub _macify {
+ my($file) = @_;
+
+ return $file unless $Is_MacOS;
+
+ $file =~ s|^\./||;
+ if ($file =~ m|/|) {
+ $file =~ s|/+|:|g;
+ $file = ":$file";
+ }
+
+ $file;
+}
+
+sub _maccat {
+ my($f1, $f2) = @_;
+
+ return "$f1/$f2" unless $Is_MacOS;
+
+ $f1 .= ":$f2";
+ $f1 =~ s/([^:]:):/$1/g;
+ return $f1;
+}
+
+sub _unmacify {
+ my($file) = @_;
+
+ return $file unless $Is_MacOS;
+
+ $file =~ s|^:||;
+ $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
+ $file =~ y|:|/|;
+
+ $file;
+}
+
1;
__END__
output. All files that match any regular expression in a file
C<MANIFEST.SKIP> (if such a file exists) are ignored.
-manicheck() checks if all the files within a C<MANIFEST> 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<MANIFEST> in the current
+directory really do exist. If C<MANIFEST> 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<MANIFEST> 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<MANIFEST> file. An optional file C<MANIFEST.SKIP>
will be consulted. Any file matching a regular expression in such a
-file will not be reported as missing in the C<MANIFEST> file.
+file will not be reported as missing in the C<MANIFEST> 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<MANIFEST.SKIP> file.
~$
\.old$
^#.*#$
+ ^\.#
If no MANIFEST.SKIP file is found, a default set of skips will be
used, similar to the example above. If you want nothing skipped,
All diagnostic output is sent to C<STDERR>.
-=over
+=over 4
=item C<Not in MANIFEST:> I<file>