view release on metacpan or  search on metacpan

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

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

    foreach (readdir(DIR)) 
    {
	next if $_ eq '.' || $_ eq '..';
	$path = "$dirName/$_";

	if (-d $path) 
	{		
	    &removeDirectory($path);
	}
	elsif (-f _) 
	{	
	    removeFile( $path );
	}
    }
    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>;
	if ( $reply =~ /^[Nn]/ )
	{
	    return;
	}
    }
    elsif ( $opt_i )
    {
	print "$fileName: ? ";
	$reply = <STDIN>;
	if ( $reply =~ /^[Nn]/ )
	{
	    return;
	}
    }

    # If we are forcing the delete first change the files mode to allow writes.
    if ( $opt_f )
    {
	my ( $mode ) = "0777";
	chmod $mode, $fileName;
    }

    # Overwrite the file with rubbish before deleting.
    if ( $opt_P )
    {
	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;

    $ff = "\0xFF";

    # Change mode if the file is readonly.
    if ( !-w $fileName )
    {
	my ( $mode ) = "0777";
	chmod $mode, $fileName;
    }

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

    ## Second pass at overwrite
    if ( open (FILEHANDLE, ">$fileName" ) )
    {
	$text = "\0" x $size;
	print $text;
	print FILEHANDLE $text;
	close ( FILEHANDLE );
    }

    ## Third  pass at overwrite
    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.

     -i    Request confirmation before attempting to remove each file, regard-
           less of the file's permissions, or whether or not the standard in-
           put device is a terminal.  The -i option overrides any previous -f
           options.