C<ExtUtils::Manifest::fullcheck;>
+C<ExtUtils::Manifest::skipcheck;>
+
+C<ExtUtild::Manifest::manifind();>
+
C<ExtUtils::Manifest::maniread($file);>
-C<ExtUtils::Manifest::manicopy($read,$target);>
+C<ExtUtils::Manifest::manicopy($read,$target,$how);>
=head1 DESCRIPTION
Mkmanifest() writes all files in and below the current directory to a
-file named C<MANIFEST> in the current directory. It works similar to
+file named in the global variable $ExtUtils::Manifest::MANIFEST (which
+defaults to C<MANIFEST>) in the current directory. It works similar to
find . -print
Fullcheck() does both a manicheck() and a filecheck().
+Skipcheck() lists all the files that are skipped due to your
+C<MANIFEST.SKIP> file.
+
+Manifind() retruns a hash reference. The keys of the hash are the
+files found below the current directory.
+
Maniread($file) reads a named C<MANIFEST> file (defaults to
C<MANIFEST> in the current directory) and returns a HASH reference
with files being the keys and comments being the values of the HASH.
-I<Manicopy($read,$target)> copies the files that are the keys in the
-HASH I<%$read> to the named target directory. The HASH reference
+I<Manicopy($read,$target,$how)> copies the files that are the keys in
+the HASH I<%$read> to the named target directory. The HASH reference
I<$read> is typically returned by the maniread() function. This
function is useful for producing a directory tree identical to the
-intended distribution tree.
+intended distribution tree. The third parameter $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 default.
=head1 MANIFEST.SKIP
C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
C<&maniread>, and C<&manicopy> are exportable.
+=head1 GLOBAL VARIABLES
+
+C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
+results in both a different C<MANIFEST> and a different
+C<MANIFEST.SKIP> file. This is useful if you want to maintain
+different distributions for different audiences (say a user version
+and a developer version including RCS).
+
+<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+all functions act silently.
+
=head1 DIAGNOSTICS
All diagnostic output is sent to C<STDERR>.
=over
-
+
=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>.
=item C<No such file:> I<file>
+
is reported if a file mentioned in a C<MANIFEST> file does not
exist.
=item C<MANIFEST:> I<$!>
+
is reported if C<MANIFEST> could not be opened.
=item C<Added to MANIFEST:> I<file>
+
is reported by mkmanifest() if $Verbose is set and a file is added
to MANIFEST. $Verbose is set to 1 by default.
=back
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
+
=head1 AUTHOR
Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
require Exporter;
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
- 'maniread', 'manicopy');
+ 'skipcheck', 'maniread', 'manicopy');
+use Config;
use File::Find;
use Carp;
$Debug = 0;
$Verbose = 1;
+$Is_VMS = $Config{'osname'} eq 'VMS';
-($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
-$Version = $Version; #avoid warning
+$VERSION = $VERSION = substr(q$Revision: 1.22 $,10,4);
$Quiet = 0;
+$MANIFEST = 'MANIFEST';
+
+# Really cool fix from Ilya :)
+unless (defined $Config{d_link}) {
+ *ln = \&cp;
+}
+
sub mkmanifest {
my $manimiss = 0;
my $read = 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 $found = manifind();
my($key,$val,$file,%all);
my %all = (%$found, %$read);
- local *M;
- rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
- open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
+ $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 ($Verbose){
- warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
+ warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
}
+ my $text = $all{$file};
+ ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
my $tabs = (5 - (length($file)+1)/8);
$tabs = 1 if $tabs < 1;
- $tabs = 0 unless $all{$file};
- print M $file, "\t" x $tabs, $all{$file}, "\n";
+ $tabs = 0 unless $text;
+ print M $file, "\t" x $tabs, $text, "\n";
}
close M;
}
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;
}
return @{(_manicheck(2))[1]};
}
+sub skipcheck {
+ _manicheck(6);
+}
+
sub _manicheck {
my($arg) = @_;
my $read = maniread();
if ($arg & 1){
my $found = manifind();
foreach $file (sort keys %$read){
- warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
+ warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
unless ( exists $found->{$file} ) {
- warn "No such file: $file\n" unless $Quiet;
- push @missfile, $file;
+ warn "No such file: $file\n" unless $Quiet;
+ push @missfile, $file;
}
}
}
$read ||= {};
my $matches = _maniskip();
my $found = manifind();
+ my $skipwarn = $arg & 4;
foreach $file (sort keys %$found){
- next if &$matches($file);
+ if (&$matches($file)){
+ warn "Skipping $file\n" if $skipwarn;
+ next;
+ }
warn "Debug: manicheck checking from disk $file\n" if $Debug;
unless ( exists $read->{$file} ) {
- warn "Not in MANIFEST: $file\n" unless $Quiet;
- push @missentry, $file;
+ warn "Not in $MANIFEST: $file\n" unless $Quiet;
+ push @missentry, $file;
}
}
}
sub maniread {
my ($mfile) = @_;
- $mfile = "MANIFEST" unless defined $mfile;
+ $mfile = $MANIFEST unless defined $mfile;
my $read = {};
local *M;
unless (open M, $mfile){
}
while (<M>){
chomp;
- /^(\S+)\s*(.*)/ and $read->{$1}=$2;
+ if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
+ else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
}
close M;
$read;
my ($mfile) = @_;
my $matches = sub {0};
my @skip ;
- my $mfile = "MANIFEST.SKIP" unless defined $mfile;
+ my $mfile = "$MANIFEST.SKIP" unless defined $mfile;
local *M;
return $matches unless -f $mfile;
open M, $mfile or return $matches;
push @skip, $_;
}
close M;
+ my $opts = $Is_VMS ? 'oi ' : 'o ';
my $sub = "\$matches = "
. "sub { my(\$arg)=\@_; return 1 if "
- . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0)
+ . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
. " }";
eval $sub;
print "Debug: $sub\n" if $Debug;
}
sub manicopy {
- my($read,$target)=@_;
+ my($read,$target,$how)=@_;
croak "manicopy() called without target argument" unless defined $target;
+ $how = 'cp' unless defined $how && $how;
require File::Path;
require File::Basename;
my(%dirs,$file);
+ $target = VMS::Filespec::unixify($target) if $Is_VMS;
+ umask 0 unless $Is_VMS;
+ File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
foreach $file (keys %$read){
- my $dir = File::Basename::dirname($file);
- File::Path::mkpath("$target/$dir");
- cp_if_diff($file, "$target/$file");
+ $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"],1,$Is_VMS ? undef : 0755);
+ }
+ if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
+ else { cp_if_diff($file, "$target/$file", $how); }
}
}
sub cp_if_diff {
- my($from,$to)=@_;
+ my($from,$to, $how)=@_;
-f $from || carp "$0: $from not found";
- system "cmp", "-s", $from, $to;
- if ($?) {
- unlink($to); # In case we don't have write permissions.
- (system 'cp', $from, $to) == 0 or confess "system 'cp': $!";
+ my($diff) = 0;
+ local(*F,*T);
+ open(F,$from) or croak "Can't read $from: $!\n";
+ if (open(T,$to)) {
+ while (<F>) { $diff++,last if $_ ne <T>; }
+ $diff++ unless eof(T);
+ close T;
+ }
+ else { $diff++; }
+ close F;
+ if ($diff) {
+ if (-e $to) {
+ unlink($to) or confess "unlink $to: $!";
+ }
+ &$how($from, $to);
+ }
+}
+
+# Do the comparisons here rather than spawning off another process
+sub vms_cp_if_diff {
+ my($from,$to) = @_;
+ my($diff) = 0;
+ local(*F,*T);
+ open(F,$from) or croak "Can't read $from: $!\n";
+ if (open(T,$to)) {
+ while (<F>) { $diff++,last if $_ ne <T>; }
+ $diff++ unless eof(T);
+ close T;
+ }
+ else { $diff++; }
+ close F;
+ if ($diff) {
+ system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
+ or confess "Copy failed: $!";
+ }
+}
+
+sub cp {
+ my ($srcFile, $dstFile) = @_;
+ my $buf;
+ open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n";
+ open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n";
+ my ($perm,$access,$mod) = (stat IN)[2,8,9];
+ syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192);
+ close IN;
+ close OUT;
+ utime $access, $mod, $dstFile;
+ # chmod a+rX-w,go-w
+ chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile );
+}
+
+sub ln {
+ my ($srcFile, $dstFile) = @_;
+ link($srcFile, $dstFile);
+ local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
+ my $mode= 0444 | (stat)[2] & 0700;
+ chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ );
+}
+
+sub best {
+ my ($srcFile, $dstFile) = @_;
+ if (-l $srcFile) {
+ cp($srcFile, $dstFile);
+ } else {
+ ln($srcFile, $dstFile);
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff