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