view release on metacpan or  search on metacpan

share/ppt/cp.pl  view on Meta::CPAN

}

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 = "";