openssl/util/copy-if-different.pl
Andy Polyakov 0d5d76c81a util/copy.pl: work around glob quirk in some of earlier 5.1x Perl versions.
In earlier 5.1x Perl versions quoting globs works only if there is
white space. If there is none, it's looking for names starting with ".

Reviewed-by: Rich Salz <rsalz@openssl.org>
Reviewed-by: Richard Levitte <levitte@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/4696)
2017-11-08 22:01:19 +01:00

80 lines
1.4 KiB
Perl

#!/usr/local/bin/perl
use strict;
use Fcntl;
# copy-if-different.pl
# Copy to the destination if the source is not the same as it.
my @filelist;
foreach my $arg (@ARGV) {
$arg =~ s|\\|/|g; # compensate for bug/feature in cygwin glob...
$arg = qq("$arg") if ($arg =~ /\s/); # compensate for bug in 5.10...
foreach (glob $arg)
{
push @filelist, $_;
}
}
my $fnum = @filelist;
if ($fnum <= 1)
{
die "Need at least two filenames";
}
my $dest = pop @filelist;
if ($fnum > 2 && ! -d $dest)
{
die "Destination must be a directory";
}
foreach (@filelist)
{
my $dfile;
if (-d $dest)
{
$dfile = $_;
$dfile =~ s|^.*[/\\]([^/\\]*)$|$1|;
$dfile = "$dest/$dfile";
}
else
{
$dfile = $dest;
}
my $buf;
if (-f $dfile)
{
sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
sysopen(OUT, $dfile, O_RDONLY|O_BINARY)
|| die "Can't Open $dfile";
while (sysread IN, $buf, 10240)
{
my $b2;
goto copy if !sysread(OUT, $b2, 10240) || $buf ne $b2;
}
goto copy if sysread(OUT, $buf, 1);
close(IN);
close(OUT);
print "NOT copying: $_ to $dfile\n";
next;
}
copy:
sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
sysopen(OUT, $dfile, O_WRONLY|O_CREAT|O_TRUNC|O_BINARY)
|| die "Can't Open $dfile";
while (sysread IN, $buf, 10240)
{
syswrite(OUT, $buf, length($buf));
}
close(IN);
close(OUT);
print "Copying: $_ to $dfile\n";
}