[WWcvs] webwork2: I've modified the renameCourse code to simply issue a warning

[Sam H. v. a. <we...@ma...>]

Log Message:
-----------
I've modified the renameCourse code to simply issue a warning when a
course directory (other than the course root dir) is not movable. I've
also added error checking for some of the more common reasons for
directories to not be movable, so that the warning message is more
informative.

Resolves bug #943.
Originally committed to branch rel-2-2-dev.
Forward-ported without modification to HEAD.

Modified Files:
--------------
    webwork2/lib/WeBWorK/Utils:
        CourseManagement.pm

Revision Data
-------------
Index: CourseManagement.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils/CourseManagement.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -Llib/WeBWorK/Utils/CourseManagement.pm -Llib/WeBWorK/Utils/CourseManagement.pm -u -r1.27 -r1.28
--- lib/WeBWorK/Utils/CourseManagement.pm
+++ lib/WeBWorK/Utils/CourseManagement.pm
@@ -28,6 +28,7 @@
 use Carp;
 use DBI;
 use File::Path qw(rmtree);
+use File::Spec;
 use WeBWorK::CourseEnvironment;
 use WeBWorK::Debug;
 use WeBWorK::Utils qw(runtime_use readDirectory);
@@ -342,17 +343,47 @@
 	my %newCourseDirs = %{ $newCE->{courseDirs} };
 	my @courseDirNames = sort { $oldCourseDirs{$a} cmp $oldCourseDirs{$b} } keys %oldCourseDirs;
 	foreach my $courseDirName (@courseDirNames) {
-		my $oldDir = $oldCourseDirs{$courseDirName};
-		my $newDir = $newCourseDirs{$courseDirName};
+		my $oldDir = File::Spec->canonpath($oldCourseDirs{$courseDirName});
+		my $newDir = File::Spec->canonpath($newCourseDirs{$courseDirName});
 		if (-e $oldDir) {
 			debug("oldDir $oldDir still exists. might move it...\n");
+			
+			# check for a few likely error conditions, since the mv error is not that helpful
+			
+			# is the source really a directory
+			unless (-d $oldDir) {
+				warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the source is not a directory. You will have to move this directory manually.\n";
+				next;
+			}
+			
+			# does the destination already exist?
 			if (-e $newDir) {
-				warn "Can't move '$oldDir' to '$newDir', since the target already exists";
-			} else {
-				debug("Going to move $oldDir to $newDir...\n");
-				my $mvResult = system $mvCmd, $oldDir, $newDir;
-				$mvResult and die "failed to move directory with command: '$mvCmd $oldDir $newDir' (errno: $mvResult): $!\n";
+				warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the target already exists. You will have to move this directory manually.\n";
+				next;
+			}
+			
+			# is oldDir's parent writeable
+			my @oldDirElements = File::Spec->splitdir($oldDir);
+			pop @oldDirElements;
+			my $oldDirParent = File::Spec->catdir(@oldDirElements);
+			unless (-w $oldDirParent) {
+				warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the source parent directory is not writeable. You will have to move this directory manually.\n";
+				next;
+			}
+			
+			# is newDir's parent writeable?
+			my @newDirElements = File::Spec->splitdir($newDir);
+			pop @newDirElements;
+			my $newDirParent = File::Spec->catdir(@newDirElements);
+			unless (-w $newDirParent) {
+				warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the destination parent directory is not writeable. You will have to move this directory manually.\n";
+				next;
 			}
+			
+			# try to move the directory
+			debug("Going to move $oldDir to $newDir...\n");
+			my $mvResult = system $mvCmd, $oldDir, $newDir;
+			$mvResult and warn "$courseDirName: failed to move directory with command: '$mvCmd $oldDir $newDir' (errno: $mvResult): $! You will have to move this directory manually.\n";
 		} else {
 			debug("oldDir $oldDir was already moved.\n");
 		}