App-RegexFileUtils

 view release on metacpan or  search on metacpan

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

### do not edit next line. Set by CS-RCS... http://www.componentsoftware.com/csrcs/uhome.htm
#REV=' @(#) $RCSfile: cp,v $ $Revision: 1.2 $ $Date: 2004/08/05 14:17:43 $ '; 
require 5;
use strict;
use Cwd;
use File::Basename;
use File::Find;
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()

$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.

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

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

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

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

        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

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

#
# Process each file named on the command line.
foreach $arg ( @ARGV )
{
    processFile( $arg );
}

#
#  Attempt to process each file / directory named on the command line.
sub processFile()
{
    my  ( $fileName )= @_;

    # See if the file is a directory.
    if ( ( -d $fileName ) && ( $opt_r || $opt_R ))
    {
	# Remove a directory recursively.
	removeDirectory( $fileName );
    }
    elsif ( ( -d $fileName ) && !( $opt_r || $opt_R ) && (!$opt_i ))

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

	rmdir( $fileName );
    }
    elsif( -f $fileName ) 
    {
	removeFile( $fileName );
    }
}

#
#  Recursively remove a directory
sub removeDirectory( )
{
    my ( $dirName ) = @_;
    my ( $path );

    unless (opendir(DIR, $dirName)) 
    {
	warn "Can't open $dirName\n";
	closedir(DIR);
	return;
    }

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

	}
    }
    closedir(DIR);

    rmdir( $dirName );
}

#
#  Remove a file, asking for confirmation, etc, as
# necessary
sub removeFile( $fileName )
{
    my ( $fileName ) = @_;
    my $reply;

    # If its read only, and we're not forcing, and interactive prompt for deletion
    #
    if ( ( ! -w $fileName ) && ( !$opt_f ) && ( $opt_i ))
    {
	print "$fileName: Read-only ? ";
	$reply = <STDIN>;

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

    {
	overWriteFile( $fileName );
    }

    # Delete the file.
    unlink( $fileName );
}

#
# Overwrite the file specified, first with x00, the xFF, then x00
sub overWriteFile( )
{
    my ( $fileName ) = @_;
    # Info returned from stat
    my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size );
    # Text we print to the file to overwrite its contents
    my ( $text, $FILEHANDLE, $ff );

    # We only want the size
    ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size ) = stat $fileName;

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

    if ( open (FILEHANDLE, ">$fileName" ) )
    {
	$text = $ff x $size;
	print FILEHANDLE $text;
	close ( FILEHANDLE );
    }
}

#
#  Read the options from the command line.
sub getOptions() 
{
     # Process options, if any.
     # Make sure defaults are set before returning!
     return unless @ARGV > 0;
    
     if ( !getopts( 'ifPrR' )  )
     {
	 showUsage();
     }
}

#
# Show the useage
sub showUsage()
{
    print << "E-O-F";
Usage: rm [-fiPrR] file ...
     The options are as follows:

     -f    Attempt to remove the files without prompting for confirmation, re-
           gardless of the file's permissions.  If the file does not exist, do
           not display a diagnostic message or modify the exit status to re-
           flect an error.  The -f option overrides any previous -i options.