copy.pl 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  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. use Fcntl;
  9. # copy.pl
  10. # Perl script 'copy' comment. On Windows the built in "copy" command also
  11. # copies timestamps: this messes up Makefile dependencies.
  12. my $stripcr = 0;
  13. my $arg;
  14. foreach $arg (@ARGV) {
  15. if ($arg eq "-stripcr")
  16. {
  17. $stripcr = 1;
  18. next;
  19. }
  20. $arg =~ s|\\|/|g; # compensate for bug/feature in cygwin glob...
  21. $arg = qq("$arg") if ($arg =~ /\s/); # compensate for bug in 5.10...
  22. foreach (glob $arg)
  23. {
  24. push @filelist, $_;
  25. }
  26. }
  27. $fnum = @filelist;
  28. if ($fnum <= 1)
  29. {
  30. die "Need at least two filenames";
  31. }
  32. $dest = pop @filelist;
  33. if ($fnum > 2 && ! -d $dest)
  34. {
  35. die "Destination must be a directory";
  36. }
  37. foreach (@filelist)
  38. {
  39. if (-d $dest)
  40. {
  41. $dfile = $_;
  42. $dfile =~ s|^.*[/\\]([^/\\]*)$|$1|;
  43. $dfile = "$dest/$dfile";
  44. }
  45. else
  46. {
  47. $dfile = $dest;
  48. }
  49. sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
  50. sysopen(OUT, $dfile, O_WRONLY|O_CREAT|O_TRUNC|O_BINARY)
  51. || die "Can't Open $dfile";
  52. while (sysread IN, $buf, 10240)
  53. {
  54. if ($stripcr)
  55. {
  56. $buf =~ tr/\015//d;
  57. }
  58. syswrite(OUT, $buf, length($buf));
  59. }
  60. close(IN);
  61. close(OUT);
  62. print "Copying: $_ to $dfile\n";
  63. }