Skip to content

Commit

Permalink
Remove old program stuff
Browse files Browse the repository at this point in the history
  • Loading branch information
@briandfoy
briandfoy committed Jun 22, 2023
1 parent 0bbdac5 commit 6bacaf6
Showing 1 changed file with 3 additions and 286 deletions.
289 changes: 3 additions & 286 deletions bin/cp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,30 +4,22 @@
Name: cp
Description: copy files and/or directories
Author: Ken Schumack, schumacks@att.net
License: perl
Author: brian d foy, bdfoy@cpan.org
License: artistic2
=end metadata
=cut


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 ###############
sub insufficientArgs($);
sub printUsage();
sub checkArgs(@);
sub findCopy; ## used by find()
sub copyFile($$); ## used by find()

=pod
B<-f> Force copy if possible (DEFAULT)
Expand Down Expand Up @@ -92,281 +84,6 @@ sub in_path {
return 0;
}

__END__
####### P R O C E S S - O P T I O N S ####################################
my $VERBOSE = 0;
my $PRESERVE = 0;
unless (getopts("fipv"))
{
&printUsage();
exit 1;
}
if (defined $main::opt_f) { $main::opt_i = undef; } ## -f overrides -i
$VERBOSE = 1 if (defined $main::opt_v);
$PRESERVE = 1 if (defined $main::opt_p);
#######
$cp::BINMODE = 1; ## default cp is binary mode
$cp::CWD = cwd(); ## where user invoked command
$cp::EXIT_STATUS = 0; ## this means everything worked
#$cp::PATH; ## used below ... mentioned here
#$cp::TARGET; ## used below
####### O S S T U F F ####################################################
$cp::USES_DRIVE_LETTER = 0; ## the Windows 'C:\' type of thing...
if ($^O =~ /Win32/i)
{
$cp::USES_DRIVE_LETTER = 1;
}
## Do not use binary mode on some OS's ...
#if ( $^O =~ /????/i ) ## need some help here
#{
# $cp::BINMODE = 0;
#}
$cp::CASE_SENSITIVE = 1;
$cp::CWD =~ s|\\|/|g; ## normalize for compares
####### C H E C K P A T H S & C L E A N U P I F N E E D E D ######
my @paths = checkArgs(@ARGV); ## checks and cleans up args
if ($#paths < 1) ## need at least one source and a target
{
insufficientArgs($#paths);
&printUsage();
exit 1;
}
####### E S T A B L I S H T H E T A R G E T ############################
my $target = pop @paths; ## last is target...
####### M O V E S O U R C E S T O T A R G E T ########################
for my $path (@paths)
{
my $current_target = $target;
if (-d $target)
{
my $base_path = basename($path);
$current_target = "$target/$base_path";
}
if ($path eq $current_target) ## check again... compare may wk out after code above
{
print STDERR "cp: $path and target $current_target are identical ... skipping\n";
$cp::EXIT_STATUS++;
next;
}
## copy it ...
if (! -d $path) ## cp'ing a file
{
copyFile($path, $current_target);
}
else ## cp'ing a directory
{
print "cp $path $current_target\n" if $VERBOSE;
$cp::TARGET = $current_target;
$cp::PATH = $path;
&File::Find::find(\&findCopy, $path); ## copy files/dirs top -> down
}
}
exit $cp::EXIT_STATUS;
################################################################################
####### E N D O F C P
################################################################################
################################################################################
### This is called via find() to copy directory trees (top down)
sub findCopy
{
$_ = uc $_ if (! $cp::CASE_SENSITIVE);
my $dir_tail = cwd(); ## find() has "cd'ed" us here...
$dir_tail = uc $dir_tail if (! $cp::CASE_SENSITIVE);
$dir_tail =~ s|^$cp::PATH||;
$dir_tail = "$dir_tail/" unless $dir_tail eq "";
if (-d $_)
{
$_ =~ s|\.$||;
$_ =~ s|\/$|| unless $_ eq '/';
mkdir "$cp::TARGET/dir_tail$_", 0777; ## umask will modify
if (! -d "$cp::TARGET/$dir_tail$_")
{
print STDERR "mv: Unable to create dir $cp::TARGET/$dir_tail/$_\n";
$cp::EXIT_STATUS++;
}
}
else
{
if ((defined $main::opt_i) && (-e "$cp::TARGET/$dir_tail/$_"))
{
my $path2show = "$cp::TARGET/$dir_tail/$_";
$path2show =~ s|^$cp::CWD|.|;
print STDERR "cp: overwrite $path2show (yes/no)? ";
my $response = <STDIN>;
return if ($response !~ /^y/i);
}
copyFile($_, "$cp::TARGET/$dir_tail/$_");
}
}
################################################################################
### This copies a single file
sub copyFile($$)
{ ## source, target
my ($path, $target) = @_;
$path = uc $path if (! $cp::CASE_SENSITIVE);
$target = uc $target if (! $cp::CASE_SENSITIVE);
if ((defined $main::opt_i) && (-e $target)) ## used if '-i' option was given
{
my $path2show = $target;
$path2show =~ s|^$cp::CWD|.|;
print STDERR "cp: overwrite $path2show (yes/no)? ";
my $response = <STDIN>;
return if ($response !~ /^y/i); ## not this one
}
print "cp $path $target\n" if $VERBOSE;
open(PATH, '<', $path) or die "Unable to read $path: $!";
open(TARGET, '>', $target) or die "Unable to create $target: $!";
if ($cp::BINMODE) { binmode PATH; binmode TARGET; }
my $buffer;
while (read PATH, $buffer, 1024) { print TARGET $buffer; }
close PATH;
close TARGET;
if ($PRESERVE) ## preserve as many file attributes as possible...
{
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat $path;
utime $atime, $mtime, ($target);
chown $uid, $gid, ($target);
my $oldMode = (07777 & $mode); ## from man -s 2 mknod
chmod $oldMode, $target;
}
}
################################################################################
## print Insufficient arguments error
sub insufficientArgs($)
{
my $arg_num = ($_[0] + 1); ## num to display
print STDERR "cp: Insufficient arguments ($arg_num)\n";
$cp::EXIT_STATUS++;
}
################################################################################
sub printUsage()
{
print STDERR <<EOE
Usage: cp [-fivp] file1 file2
cp [-fivp] file1... filex dir
cp [-fivp] dir1... dirx dir
cp [-fivp] dir1... dirx file1... filex dir
EOE
}
################################################################################
sub checkArgs(@)
{
my $target = $_[$#_];
if ($#_ > 1) ### cp'ing > 1 thing target has to be an existing directory
{
if (! -e $target) ## has to be an existing directory... sorry it's over
{
print STDERR "cp: $target not found\n";
print STDERR " exiting...\n";
$cp::EXIT_STATUS++;
exit $cp::EXIT_STATUS
}
elsif (! -d $target) ## can only work if a directory...
{
print STDERR "cp: Target $target must be a directory when cp'ing > 1 thing\n";
print STDERR " exiting...\n";
printUsage();
$cp::EXIT_STATUS++;
exit $cp::EXIT_STATUS
}
}
my $paths = "";
my $Cwd = cwd();
$Cwd = uc $Cwd if (! $cp::CASE_SENSITIVE);
$Cwd =~ s|[/\\]$|| unless $Cwd eq '/'; ## remove any possible trailing slash (DOS or UNIX style)
my @paths = "";
for my $path (@_) ## check all paths passed in
{
$path =~ s|\\|/|g; ## normalize
## if OS is not case sensitive then let's just set to uc and make life easy
$path = uc $path if (! $cp::CASE_SENSITIVE);
if ((! -e $path) && ($path ne $target))
{
print STDERR "cp: can not access $path ... skipping\n";
$cp::EXIT_STATUS++;
## continue on... ignore this one
}
elsif (((! -d $path) && (! -r $path)) && ($path ne $target))
{
print STDERR "cp: can not read $path ... skipping\n";
$cp::EXIT_STATUS++;
## continue on... ignore this one
}
else
{
$path =~ s|^\.\/||; ## no need for './' at the path start
if ($path =~ /^\.\.\//) ## change relative to full path
{ ## ../../abc to /aaa/bbb/ccc/abc
my $path_front = $Cwd;
$path_front = uc $path if (! $cp::CASE_SENSITIVE);
while ($path =~ /^\.\.\//)
{
$path =~ s|^...||;
$path_front =~ s|(.*)\/[^\/]+|$1/|;
}
$path = $path_front.$path;
}
elsif (($path !~ /\//) && ($path !~ /^[a-z]:/i) && $cp::USES_DRIVE_LETTER) ## it's right here...
{
$path = "$Cwd/$path";
}
elsif (($path !~ /\//) && (! $cp::USES_DRIVE_LETTER)) ## it's right here...
{
$path = "$Cwd/$path";
}
while ($path =~ /\/\.\./) ## remove '/..' from middle or end of path
{
$path =~ s|[^\/]+\/\.\.||;
}
$path =~ s|\/\.?$|| unless $path eq '/'; ## remove '/' or '/.' from end of path
my $path_cnt = 0; ## number used for splicing
for my $tmpPath (@paths)
{
if ($path eq $tmpPath)
{
print STDERR "cp: $path found more than once on command line. Ignoring 1st occurance\n";
$cp::EXIT_STATUS++;
splice @paths, $path_cnt, 1;
}
else
{
$path_cnt++;
}
}
push @paths, $path;
}
}
splice @paths, 0, 1; ## the "my @paths" initialization gave this....
return @paths; ## checked, cleaned, and ready to go...
}
__END__
=pod
=head1 NAME
Expand Down

0 comments on commit 6bacaf6

Please sign in to comment.