copy.pl 1.1 KB

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