openssl/util/copy.pl
Andy Polyakov 1097d2a39e 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>
(Merged from https://github.com/openssl/openssl/pull/4695)
2017-11-10 09:39:29 +01:00

79 lines
1.4 KiB
Perl

#! /usr/bin/env perl
# Copyright 2005-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
use Fcntl;
# copy.pl
# Perl script 'copy' comment. On Windows the built in "copy" command also
# copies timestamps: this messes up Makefile dependencies.
my $stripcr = 0;
my $arg;
foreach $arg (@ARGV) {
if ($arg eq "-stripcr")
{
$stripcr = 1;
next;
}
$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, $_;
}
}
$fnum = @filelist;
if ($fnum <= 1)
{
die "Need at least two filenames";
}
$dest = pop @filelist;
if ($fnum > 2 && ! -d $dest)
{
die "Destination must be a directory";
}
foreach (@filelist)
{
if (-d $dest)
{
$dfile = $_;
$dfile =~ s|^.*[/\\]([^/\\]*)$|$1|;
$dfile = "$dest/$dfile";
}
else
{
$dfile = $dest;
}
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)
{
if ($stripcr)
{
$buf =~ tr/\015//d;
}
syswrite(OUT, $buf, length($buf));
}
close(IN);
close(OUT);
print "Copying: $_ to $dfile\n";
}