require Exporter;
use Config;
-use File::Find;
+use File::Basename;
use File::Copy 'copy';
+use File::Find;
use File::Spec;
use Carp;
use strict;
$Is_MacOS $Is_VMS
$Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
-$VERSION = 1.39;
+$VERSION = '1.49';
@ISA=('Exporter');
@EXPORT_OK = qw(mkmanifest
manicheck filecheck fullcheck skipcheck
$Quiet = 0;
$MANIFEST = 'MANIFEST';
-my $Filename = __FILE__;
-$DEFAULT_MSKIP = (File::Spec->splitpath($Filename))[1].
- "$MANIFEST.SKIP";
+$DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
=head1 NAME
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.
+directory are in sync it silently returns 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.
my $read = {};
local *M;
unless (open M, $mfile){
- warn "$mfile: $!";
- return $read;
+ warn "$mfile: $!";
+ return $read;
}
+ local $_;
while (<M>){
- chomp;
- next if /^#/;
+ chomp;
+ next if /^\s*#/;
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/./_/;
- my(@pieces) = split(/\./,$base);
- if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
- my $okfile = "$dir$base";
- warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+ 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/./_/;
+ my(@pieces) = split(/\./,$base);
+ if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
+ my $okfile = "$dir$base";
+ warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
$file = $okfile;
$file = lc($file) unless $file =~ /^MANIFEST(\.SKIP)?$/;
- }
+ }
$read->{$file} = $comment;
}
sub _maniskip {
my @skip ;
my $mfile = "$MANIFEST.SKIP";
- local *M;
+ local(*M,$_);
open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
while (<M>){
chomp;
+ s/\r//;
next if /^#/;
next if /^\s*$/;
push @skip, _macify($_);
}
close M;
+ return sub {0} unless (scalar @skip > 0);
+
my $opts = $Is_VMS ? '(?i)' : '';
# Make sure each entry is isolated in its own parentheses, in case
=item manicopy
- manicopy($src, $dest_dir);
- manicopy($src, $dest_dir, $how);
+ manicopy(\%src, $dest_dir);
+ manicopy(\%src, $dest_dir, $how);
+
+Copies the files that are the keys in %src to the $dest_dir. %src is
+typically returned by the maniread() function.
-copies the files that are the keys in the HASH I<%$src> to the
-$dest_dir. The HASH reference $read is typically returned by the
-maniread() function. This function is useful for producing a directory
-tree identical to the intended distribution tree. The third parameter
-$how can be used to specify a different methods of "copying". Valid
+ manicopy( maniread(), $dest_dir );
+
+This function is useful for producing a directory tree identical to the
+intended distribution tree.
+
+$how can be used to specify a different methods of "copying". Valid
values are C<cp>, which actually copies the files, C<ln> which creates
hard links, and C<best> which mostly links the files but copies any
-symbolic link to make a tree without any symbolic link. Best is the
+symbolic link to make a tree without any symbolic link. C<cp> is the
default.
=cut
local(*F,*T);
open(F,"< $from\0") or die "Can't read $from: $!\n";
if (open(T,"< $to\0")) {
+ local $_;
while (<F>) { $diff++,last if $_ ne <T>; }
$diff++ unless eof(T);
close T;
if (-e $to) {
unlink($to) or confess "unlink $to: $!";
}
- STRICT_SWITCH: {
+ STRICT_SWITCH: {
best($from,$to), last STRICT_SWITCH if $how eq 'best';
cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
sub cp {
my ($srcFile, $dstFile) = @_;
- my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+ my ($access,$mod) = (stat $srcFile)[8,9];
+
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');
+ _manicopy_chmod($dstFile);
}
+
sub ln {
my ($srcFile, $dstFile) = @_;
return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
link($srcFile, $dstFile);
- # 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 ), $_ )) {
+ unless( _manicopy_chmod($dstFile) ) {
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;
-}
-
-
+# 1) Strip off all group and world permissions.
+# 2) Let everyone read it.
+# 3) If the owner can execute it, everyone can.
+sub _manicopy_chmod {
+ my($file) = shift;
+ my $perm = 0444 | (stat $file)[2] & 0700;
+ chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $file );
+}
+# Files that are often modified in the distdir. Don't hard link them.
+my @Exceptions = qw(MANIFEST META.yml SIGNATURE);
sub best {
my ($srcFile, $dstFile) = @_;
- if (-l $srcFile) {
+
+ my $is_exception = grep $srcFile =~ /$_/, @Exceptions;
+ if ($is_exception or !$Config{d_link} or -l $srcFile) {
cp($srcFile, $dstFile);
} else {
ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
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;
my($file) = @_;
return $file unless $Is_MacOS;
-
+
$file =~ s|^:||;
$file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
$file =~ y|:|/|;
-
+
$file;
}
maniadd({ $file => $comment, ...});
-Adds an entry to an existing F<MANIFEST>.
+Adds an entry to an existing F<MANIFEST> unless its already there.
$file will be normalized (ie. Unixified). B<UNIMPLEMENTED>
my($additions) = shift;
_normalize($additions);
+ _fix_manifest($MANIFEST);
my $manifest = maniread();
- open(MANIFEST, ">>$MANIFEST") or die "Could not open $MANIFEST: $!";
- foreach my $file (_sort keys %$additions) {
+ my @needed = grep { !exists $manifest->{$_} } keys %$additions;
+ return 1 unless @needed;
+
+ open(MANIFEST, ">>$MANIFEST") or
+ die "maniadd() could not open $MANIFEST: $!";
+
+ foreach my $file (_sort @needed) {
my $comment = $additions->{$file} || '';
- printf MANIFEST "%-40s%s\n", $file, $comment unless
- exists $manifest->{$file};
+ printf MANIFEST "%-40s %s\n", $file, $comment;
}
+ close MANIFEST or die "Error closing $MANIFEST: $!";
+
+ return 1;
+}
+
+
+# Sometimes MANIFESTs are missing a trailing newline. Fix this.
+sub _fix_manifest {
+ my $manifest_file = shift;
+
+ open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
+
+ # Yes, we should be using seek(), but I'd like to avoid loading POSIX
+ # to get SEEK_*
+ my @manifest = <MANIFEST>;
close MANIFEST;
+
+ unless( $manifest[-1] =~ /\n\z/ ) {
+ open MANIFEST, ">>$MANIFEST" or die "Could not open $MANIFEST: $!";
+ print MANIFEST "\n";
+ close MANIFEST;
+ }
}
+
# UNIMPLEMENTED
sub _normalize {
return;
=head2 MANIFEST
+A list of files in the distribution, one file per line. The MANIFEST
+always uses Unix filepath conventions even if you're not on Unix. This
+means F<foo/bar> style not F<foo\bar>.
+
Anything between white space and an end of line within a C<MANIFEST>
-file is considered to be a comment. Filenames and comments are
-separated by one or more TAB characters in the output.
+file is considered to be a comment. Any line beginning with # is also
+a comment.
+
+ # this a comment
+ some/file
+ some/other/file comment about some/file
=head2 MANIFEST.SKIP
should be ignored by mkmanifest() and filecheck(). The regular
expressions should appear one on each line. Blank lines and lines
which start with C<#> are skipped. Use C<\#> if you need a regular
-expression to start with a sharp character. A typical example:
+expression to start with a C<#>.
+
+For example:
# Version control files and dirs.
\bRCS\b
=head1 AUTHOR
-Andreas Koenig <F<andreas.koenig@anima.de>>
+Andreas Koenig C<andreas.koenig@anima.de>
+
+Maintained by Michael G Schwern C<schwern@pobox.com> within the
+ExtUtils-MakeMaker package and, as a separate CPAN package, by
+Randy Kobes C<r.kobes@uwinnipeg.ca>.
=cut