#!/usr/bin/perl
=begin metadata
Name: cp
Description: copy files and/or directories
Author: brian d foy, bdfoy@cpan.org
License: artistic2
=end metadata
=cut
package PerlPowerTools::cp;
use strict;
use Cwd;
use Config;
use ExtUtils::MakeMaker qw(prompt);
use File::Basename qw(basename);
use File::Spec::Functions qw(catfile);
exit( run( {}, @ARGV) ) unless caller;
BEGIN {
$PerlPowerTools::cp::error_fh = \*STDERR;
$PerlPowerTools::cp::output_fh = \*STDOUT;
}
sub error_fh { $PerlPowerTools::cp::error_fh }
sub output_fh { $PerlPowerTools::cp::output_fh }
use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;
use constant EX_USAGE => 2;
sub run {
my( $settings, @args ) = @_;
$settings = {} unless defined $settings;
$PerlPowerTools::cp::error_fh = $settings->{error_fh} if exists $settings->{error_fh};
$PerlPowerTools::cp::output_fh = $settings->{output_fh} if exists $settings->{output_fh};
my( $opts, @files) = process_arguments(@args);
my $destination = pop @files;
return EX_USAGE unless defined $opts;
unless (@files) {
warn "$0: missing file operand\n";
return EX_USAGE;
}
my @unix_like = qw(darwin freebsd linux);
if( 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, @files, $destination;
my $rc = system { $command[0] } @command;
return $rc;
}
else {
require File::Copy;
my $err = 0;
foreach my $source (@files) {
my $catdst = $destination;
if( -d $destination ) {
$catdst = catfile( $destination, basename($source) )
}
print { output_fh() } "$source -> $catdst\n" if $opts->{v};
if( -e $catdst and $opts->{i} and ! $opts->{f} ) {
my $answer = prompt( "overwrite $catdst? (y/n [n])", 'n' );
unless( $answer =~ m/\A\s*y/i ) {
print { error_fh() } "not overwritten";
return EX_FAILURE;
}
}
$err = 1 if (File::Copy::copy($source, $catdst) == 0);
}
return $err ? EX_FAILURE : EX_SUCCESS;
}
return EX_FAILURE;
}
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;
}
sub process_arguments {
my @args = @_;
my %opts;
require Getopt::Long;
my $ret = Getopt::Long::GetOptionsFromArray(
\@args,
'f' => \$opts{'f'},
'i' => \$opts{'i'},
'n' => \$opts{'n'},
'p' => \$opts{'p'},
'v' => \$opts{'v'},
);
return unless $ret;
return ( \%opts, @args )
}
__PACKAGE__;
=pod
=encoding utf8
=head1 NAME
cp - copy files and/or directories
=head1 SYNOPSIS
% cp [ B<-fipv> ] source_file target_file
% cp [ B<-fipv> ] source... target_dir
=head1 DESCRIPTION
The cp utility copies the source files/directories to the target. If the
target is a file you may only specify one file as the source. cp will not
copy a file onto itself.
=head2 OPTIONS
=over 4
=item * B<-f> - force copy if possible (DEFAULT)
=item * B<-i> - prompt for confirmation whenever the copy would overwrite an existing target.
=item * B<-p> - preserve source file attributes (like modDate) as much as possible onto the target.
=item * B<-v> - verbose. Echo "cp source target" before copy is done.
=back
Specifying both B<-f> and B<-i> options is not considered an
error. The B<-f> option will override the B<-i> option.
=head1 BUGS
B<cp> has no known bugs, but be aware that the current copy mode
is binary mode.
=head1 EXIT STATUS
=over 4
=item * 0 - All sources were copied successfully.
=item * 1 - There was error
=back
=head1 AUTHOR
brian d foy, E<lt>schumacks@att.netE<gt>
=head1 COPYRIGHT and LICENSE
Copyright © 2023 brian d foy. All rights reserved.
You may use this program under the terms of the Artistic License 2.0.
=cut