util/copy.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2005-2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the OpenSSL license (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9
  10 use Fcntl;
  11
  12
  13 # copy.pl
  14
  15 # Perl script 'copy' comment. On Windows the built in "copy" command also
  16 # copies timestamps: this messes up Makefile dependencies.
  17
  18 my $stripcr = 0;
  19
  20 my $arg;
  21
  22 foreach $arg (@ARGV) {
  23         if ($arg eq "-stripcr")
  24                 {
  25                 $stripcr = 1;
  26                 next;
  27                 }
  28         $arg =~ s|\\|/|g;       # compensate for bug/feature in cygwin glob...
  29         $arg = qq("$arg") if ($arg =~ /\s/);    # compensate for bug in 5.10...
  30         foreach (glob $arg)
  31                 {
  32                 push @filelist, $_;
  33                 }
  34 }
  35
  36 $fnum = @filelist;
  37
  38 if ($fnum <= 1)
  39         {
  40         die "Need at least two filenames";
  41         }
  42
  43 $dest = pop @filelist;
  44
  45 if ($fnum > 2 && ! -d $dest)
  46         {
  47         die "Destination must be a directory";
  48         }
  49
  50 foreach (@filelist)
  51         {
  52         if (-d $dest)
  53                 {
  54                 $dfile = $_;
  55                 $dfile =~ s|^.*[/\\]([^/\\]*)$|$1|;
  56                 $dfile = "$dest/$dfile";
  57                 }
  58         else
  59                 {
  60                 $dfile = $dest;
  61                 }
  62         sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
  63         sysopen(OUT, $dfile, O_WRONLY|O_CREAT|O_TRUNC|O_BINARY)
  64                                         || die "Can't Open $dfile";
  65         while (sysread IN, $buf, 10240)
  66                 {
  67                 if ($stripcr)
  68                         {
  69                         $buf =~ tr/\015//d;
  70                         }
  71                 syswrite(OUT, $buf, length($buf));
  72                 }
  73         close(IN);
  74         close(OUT);
  75         print "Copying: $_ to $dfile\n";
  76         }
  77
  78