File Coverage

/root/.cpan/build/PerlPowerTools-1.053-0/bin/cp

Criterion	Covered	Total	%
statement	55	88	62.5
branch	10	32	31.2
condition	1	9	11.1
subroutine	12	15	80.0
pod			n/a
total	78	144	54.1

#!/usr/bin/perl

=begin metadata

Name: cp
Description: copy files and/or directories
Author: brian d foy, [e-mail]
License: artistic2

=end metadata

=cut

package PerlPowerTools::cp;

use strict;

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";
		usage();
		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 >> 8;
		}
	else {
		require File::Copy;
		my $err = 0;
		foreach my $source (@files) {
			if (-d $source) {
				print { error_fh() } "$0: '$source' is a directory (not copied)\n";
				$err = 1;
				next;
			}
			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' );
				next unless $answer =~ m/\A\s*y/i;
				}
			if (File::Copy::copy($source, $catdst) == 0) {
				print { error_fh() } "$0: $source -> $catdst: copy failed: $!\n";
				$err = 1;
				}
			}
		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;
	Getopt::Long::Configure('bundling');
	Getopt::Long::GetOptionsFromArray(
		\@args,
		'f' => \$opts{'f'},
		'i' => \$opts{'i'},
		'n' => \$opts{'n'},
		'p' => \$opts{'p'},
		'v' => \$opts{'v'},
	) or do {
		usage();
		return;
	};
	return ( \%opts, @args )
	}

sub usage {
    require Pod::Usage;
    Pod::Usage::pod2usage({ -exitval => 'NOEXIT', -verbose => 0 });
}

__PACKAGE__;

=pod

=encoding utf8

=head1 NAME

cp - copy files and/or directories

=head1 SYNOPSIS

	% cp [-fipv] source_file  target_file
	% cp [-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 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-mail]

=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