Home | History | Annotate | Line # | Download | only in util
      1  1.1  christos #! /usr/bin/env perl
      2  1.1  christos # Copyright 2005-2018 The OpenSSL Project Authors. All Rights Reserved.
      3  1.1  christos #
      4  1.1  christos # Licensed under the Apache License 2.0 (the "License").  You may not use
      5  1.1  christos # this file except in compliance with the License.  You can obtain a copy
      6  1.1  christos # in the file LICENSE in the source distribution or at
      7  1.1  christos # https://www.openssl.org/source/license.html
      8  1.1  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  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  christos 	if ($arg =~ /^-exclude_re=(.*)$/)
     30  1.1  christos 		{
     31  1.1  christos 		push @excludes, $1;
     32  1.1  christos 		next;
     33  1.1  christos 		}
     34  1.1  christos 	$arg =~ s|\\|/|g;	# compensate for bug/feature in cygwin glob...
     35  1.1  christos 	$arg = qq("$arg") if ($arg =~ /\s/);	# compensate for bug in 5.10...
     36  1.1  christos 	foreach my $f (glob $arg)
     37  1.1  christos 		{
     38  1.1  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  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  christos 
     84  1.1  christos 
     85