Perl function: moveDirectory

来源:互联网 发布:程序员的思维修炼 豆瓣 编辑:程序博客网 时间:2024/05/01 00:35

#------------------------------

#

# moveDirectory

#

# Creates the directory specified if it does not exist

# Copies files from the specified directory to the created one

# Deletes the files in the specified directory

#  do all files copy then remove all files, 

# so when copy failed, we still can recover all files from

# source directory.

#

# in: Source Directory, Target Directory

# out: return code (true/false)

#

sub moveDirectory {

my $sourceDir = $_[0];

my $targetDir = $_[1];

my @filelist = ();

    my @rmDirCmd = ();

    

if ( -d $targetDir ) {

print "Target directory ($targetDir) already exists, aborting stamp!/n";

return FALSE;

}

if (! mkdir $targetDir, 0777) {

print "Unable to create target directory ($targetDir), aborting stamp!/n";

return FALSE;

}

@filelist= getFileList ($sourceDir);

for (@filelist) {

# recursive call to subdirs if subdirs exist in the source location

   if ( -d "$sourceDir//$_" ){

if (! moveDirectory ("$sourceDir//$_", "$targetDir//$_")) {

dieErr ("Failure occurred attempting to copy subdirectories ($targetDir//$_)/n");

}

   } else {

if(! copy("$sourceDir//$_", "$targetDir//$_")) {

print "Unable to copy $_ to $targetDir, aborting stamp!/n";

return FALSE;

}

}

}

for (@filelist) {

if ( -d "$sourceDir//$_" ){

@rmDirCmd = ("$rmDirExe", "-p", "$sourceDir//$_");

   system(@rmDirCmd);

   # problem in checkin reture code, we check the directory again, if directory still

   # exist, then remove directory command was failed

   if ( -d "$sourceDir//$_" ) {

logTransaction ("----->  rmdir $sourceDir//$_ failed");

print "Unable to delete directory $sourceDir//$_, aborting stamp!/n";

return FALSE;

}

} else {

if (! unlink ("$sourceDir//$_")) {

print "Unable to delete $_ from $sourceDir, aborting stamp!/n";

return FALSE;

}

}

}

return TRUE;

}