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