Skip to content

Commit

Permalink
shell out to copy/cp if it's around, otherwise File::Copy
Browse files Browse the repository at this point in the history
  • Loading branch information
briandfoy committed Jun 21, 2023
1 parent d62f527 commit 7229037
Showing 1 changed file with 67 additions and 5 deletions.
72 changes: 67 additions & 5 deletions bin/cp
Expand Up @@ -15,8 +15,10 @@ License: perl
require 5;
use strict;
use Cwd;
use Config;
use File::Basename;
use File::Find;
use File::Spec::Functions qw(catfile);
use Getopt::Std;

####### S U B R O U T I N E S ###############
Expand All @@ -26,11 +28,71 @@ sub checkArgs(@);
sub findCopy; ## used by find()
sub copyFile($$); ## used by find()

$main::opt_f = undef; ## used and set by getopts()
$main::opt_i = undef; ## used and set by getopts()
$main::opt_p = undef; ## used and set by getopts()
$main::opt_v = undef; ## used and set by getopts() not standard, but may be helpful
## especially if problems are found w/ routine.
=pod
B<-f> Force copy if possible (DEFAULT)
B<-i> Prompt for confirmation whenever the copy would overwrite an existing target.
B<-p> Preserve source file attributes (like modDate) as much as possible onto the target.
B<-v> Verbose. Echo "cp source target" before copy is done.
=cut

run(@ARGV) unless caller;

sub run {
my @args = @_;

require Getopt::Long;
my %opts;

my $ret = Getopt::Long::GetOptionsFromArray(
\@args,
'f' => \$opts{'f'},
'i' => \$opts{'i'},
'p' => \$opts{'p'},
'v' => \$opts{'v'},
);
my( $source, $destination ) = @args;

my @unix_like = qw(darwin freebsd linux);
if( $^O eq 'MSWin32' ) {
# https://home.csulb.edu/~murdock/copy.html
my @command = 'copy';
push @command, '/-Y' if $opts{i};
push @command, $source, $destination;

print "cp $source $destination\n" if $opts{v};
my $rc = system { $command[0] } @command
}
elsif( grep { $^O eq $_ } @unix_like and in_path('cp') ) {
# Although File::Copy seems like it should do the right thing,
# it doesn't.
my @command = 'cp';
push @command, map { "-$_" } grep { $opts{$_} } qw(i f p v );
push @command, $source, $destination;

my $rc = system { $command[0] } @command
}
else {
require File::Copy;
print "cp $source $destination\n" if $opts{v};
File::Copy::copy( $source, $destination );
}
};

sub in_path {
my( $command ) = @_;
foreach my $dir ( split /$Config{path_sep}/, $ENV{PATH} ) {
my $path = catfile( $dir, $command );
return 1 if -x $path;
}
return 0;
}

__END__
####### P R O C E S S - O P T I O N S ####################################
my $VERBOSE = 0;
Expand Down

0 comments on commit 7229037

Please sign in to comment.