Menu
▾
▴
[WWcvs] webwork2: Added course renaming to CourseManagement, CourseAdmin.
|
From: Sam H. v. a. <act...@de...> - 2004-12-21 04:56:19
|
Log Message:
-----------
Added course renaming to CourseManagement, CourseAdmin.
It works like this:
- move the course directory
- move any course subdirectories that are still at their old locations
(like if they were outside the course directory)
- create a new database using addCourseHelper()
- copy the course data into the new course database using
copyCourseDataHelper() (INSERT INTO $new SELECT * FROM $old)
- delete the old course database using deleteCourseHelper()
TODO:
* write helpers for gdbm and sql layouts
* write command-line script
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
CourseAdmin.pm
webwork2/lib/WeBWorK/Utils:
CourseManagement.pm
webwork2/lib/WeBWorK/Utils/CourseManagement:
sql_single.pm
Revision Data
-------------
Index: CourseAdmin.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -Llib/WeBWorK/ContentGenerator/CourseAdmin.pm -Llib/WeBWorK/ContentGenerator/CourseAdmin.pm -u -r1.32 -r1.33
--- lib/WeBWorK/ContentGenerator/CourseAdmin.pm
+++ lib/WeBWorK/ContentGenerator/CourseAdmin.pm
@@ -30,7 +30,7 @@
use File::Temp qw/tempfile/;
use WeBWorK::CourseEnvironment;
use WeBWorK::Utils qw(cryptPassword writeLog);
-use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);
+use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses);
use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
# put the following database layouts at the top of the list, in this order
@@ -57,10 +57,6 @@
return;
}
- # get result and send to message
- my $status_message = $r->param("status_message");
- $self->addmessage(CGI::p("$status_message")) if $status_message;
-
## if the user is asking for the downloaded database...
#if (defined $r->param("download_exported_database")) {
# my $courseID = $r->param("export_courseID");
@@ -98,6 +94,19 @@
}
}
+ elsif ($subDisplay eq "rename_course") {
+ if (defined $r->param("rename_course")) {
+ @errors = $self->rename_course_validate;
+ if (@errors) {
+ $method_to_call = "rename_course_form";
+ } else {
+ $method_to_call = "do_rename_course";
+ }
+ } else {
+ $method_to_call = "rename_course_form";
+ }
+ }
+
elsif ($subDisplay eq "delete_course") {
if (defined $r->param("delete_course")) {
# validate or confirm
@@ -212,6 +221,8 @@
print CGI::p({style=>"text-align: center"},
CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
" | ",
+ CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
+ " | ",
CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
" | ",
CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
@@ -656,7 +667,7 @@
if ($add_admin_users ne "") {
foreach my $userID ($db->listUsers) {
if ($userID eq $add_initial_userID) {
- $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
+ warn "User '$userID' will not be copied from admin course as it is the initial instructor.";
next;
}
my $User = $db->getUser($userID);
@@ -746,6 +757,256 @@
}
+}
+
+################################################################################
+
+sub rename_course_form {
+ my ($self) = @_;
+ my $r = $self->r;
+ my $ce = $r->ce;
+ #my $db = $r->db;
+ #my $authz = $r->authz;
+ #my $urlpath = $r->urlpath;
+
+ my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
+ my $rename_newCourseID = $r->param("rename_newCourseID") || "";
+
+ my $rename_sql_host = $r->param("rename_sql_host") || "";
+ my $rename_sql_port = $r->param("rename_sql_port") || "";
+ my $rename_sql_username = $r->param("rename_sql_username") || "";
+ my $rename_sql_password = $r->param("rename_sql_password") || "";
+ my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
+ my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
+ my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
+
+ my @courseIDs = listCourses($ce);
+ @courseIDs = sort @courseIDs;
+
+ my %courseLabels; # records... heh.
+ foreach my $courseID (@courseIDs) {
+ my $tempCE = WeBWorK::CourseEnvironment->new(
+ $ce->{webworkDirs}->{root},
+ $ce->{webworkURLs}->{root},
+ $ce->{pg}->{directories}->{root},
+ $courseID,
+ );
+ $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
+ }
+
+ print CGI::h2("Rename Course");
+
+ print CGI::start_form("POST", $r->uri);
+ print $self->hidden_authen_fields;
+ print $self->hidden_fields("subDisplay");
+
+ print CGI::p("Select a course to rename.");
+
+ print CGI::table({class=>"FormLayout"},
+ CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "Course Name:"),
+ CGI::td(
+ CGI::scrolling_list(
+ -name => "rename_oldCourseID",
+ -values => \@courseIDs,
+ -default => $rename_oldCourseID,
+ -size => 10,
+ -multiple => 0,
+ -labels => \%courseLabels,
+ ),
+ ),
+ ),
+ CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "New Name:"),
+ CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
+ ),
+ );
+
+ print CGI::p(
+ "If the course's database layout (indicated in parentheses above) is "
+ . CGI::b("sql") . ", supply the SQL connections information requested below."
+ );
+
+ print CGI::start_table({class=>"FormLayout"});
+ print CGI::Tr(CGI::td({colspan=>2},
+ "Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
+ )
+ );
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
+ CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
+ );
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
+ CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
+ );
+
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
+ CGI::td(
+ CGI::textfield("rename_sql_host", $rename_sql_host, 25),
+ CGI::br(),
+ CGI::small("Leave blank to use the default host."),
+ ),
+ );
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
+ CGI::td(
+ CGI::textfield("rename_sql_port", $rename_sql_port, 25),
+ CGI::br(),
+ CGI::small("Leave blank to use the default port."),
+ ),
+ );
+
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
+ CGI::td(
+ CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
+ CGI::br(),
+ CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
+ ),
+ );
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
+ CGI::td(
+ CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
+ CGI::br(),
+ CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
+ ),
+ );
+ print CGI::Tr(
+ CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
+ CGI::td(
+ CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost || "localhost", 25),
+ CGI::br(),
+ CGI::small("If the SQL server does not run on the same host as WeBWorK, enter the host name of the WeBWorK server as seen by the SQL server."),
+ ),
+ );
+ print CGI::end_table();
+
+ print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
+
+ print CGI::end_form();
+}
+
+sub rename_course_validate {
+ my ($self) = @_;
+ my $r = $self->r;
+ my $ce = $r->ce;
+ #my $db = $r->db;
+ #my $authz = $r->authz;
+ #my $urlpath = $r->urlpath;
+
+ my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
+ my $rename_newCourseID = $r->param("rename_newCourseID") || "";
+
+ my $rename_sql_host = $r->param("rename_sql_host") || "";
+ my $rename_sql_port = $r->param("rename_sql_port") || "";
+ my $rename_sql_username = $r->param("rename_sql_username") || "";
+ my $rename_sql_password = $r->param("rename_sql_password") || "";
+ my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
+ my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
+ my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
+
+ my @errors;
+
+ if ($rename_oldCourseID eq "") {
+ push @errors, "You must select a course to rename.";
+ }
+ if ($rename_newCourseID eq "") {
+ push @errors, "You must specify a new name for the course.";
+ }
+ if ($rename_oldCourseID eq $rename_newCourseID) {
+ push @errors, "Can't rename to the same name.";
+ }
+ unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
+ push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
+ }
+ if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
+ push @errors, "A course with ID $rename_newCourseID already exists.";
+ }
+
+ my $ce2 = WeBWorK::CourseEnvironment->new(
+ $ce->{webworkDirs}->{root},
+ $ce->{webworkURLs}->{root},
+ $ce->{pg}->{directories}->{root},
+ $rename_oldCourseID,
+ );
+
+ if ($ce2->{dbLayoutName} eq "sql") {
+ push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
+ #push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
+ #push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
+ #push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
+ }
+
+ return @errors;
+}
+
+sub do_rename_course {
+ my ($self) = @_;
+ my $r = $self->r;
+ my $ce = $r->ce;
+ my $db = $r->db;
+ #my $authz = $r->authz;
+ my $urlpath = $r->urlpath;
+
+ my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
+ my $rename_newCourseID = $r->param("rename_newCourseID") || "";
+
+ my $rename_sql_host = $r->param("rename_sql_host") || "";
+ my $rename_sql_port = $r->param("rename_sql_port") || "";
+ my $rename_sql_username = $r->param("rename_sql_username") || "";
+ my $rename_sql_password = $r->param("rename_sql_password") || "";
+ my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
+ my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
+ my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
+
+ my $ce2 = WeBWorK::CourseEnvironment->new(
+ $ce->{webworkDirs}->{root},
+ $ce->{webworkURLs}->{root},
+ $ce->{pg}->{directories}->{root},
+ $rename_oldCourseID,
+ );
+
+ my $dbLayoutName = $ce->{dbLayoutName};
+
+ my %dbOptions;
+ if ($dbLayoutName eq "sql") {
+ $dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
+ $dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
+ $dbOptions{username} = $rename_sql_username;
+ $dbOptions{password} = $rename_sql_password;
+ $dbOptions{old_database} = $rename_sql_oldDatabase || "webwork_$rename_oldCourseID";
+ $dbOptions{new_database} = $rename_sql_newDatabase || "webwork_$rename_newCourseID";
+ $dbOptions{wwhost} = $rename_sql_wwhost;
+ }
+
+ eval {
+ renameCourse(
+ courseID => $rename_oldCourseID,
+ ce => $ce2,
+ dbOptions => \%dbOptions,
+ newCourseID => $rename_newCourseID,
+ );
+ };
+ if ($@) {
+ my $error = $@;
+ print CGI::div({class=>"ResultsWithError"},
+ CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
+ CGI::tt(CGI::escapeHTML($error)),
+ );
+ } else {
+ print CGI::div({class=>"ResultsWithoutError"},
+ CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
+ );
+ my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
+ courseID => $rename_newCourseID);
+ my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
+ print CGI::div({style=>"text-align: center"},
+ CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
+ );
+ }
}
################################################################################
Index: CourseManagement.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils/CourseManagement.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Llib/WeBWorK/Utils/CourseManagement.pm -Llib/WeBWorK/Utils/CourseManagement.pm -u -r1.20 -r1.21
--- lib/WeBWorK/Utils/CourseManagement.pm
+++ lib/WeBWorK/Utils/CourseManagement.pm
@@ -233,15 +233,45 @@
}
-=item renameCourse($webworkRoot, $oldCourseID, $newCourseID)
+=item renameCourse(%options)
-Rename the course named $oldCourseID to $newCourseID.
+%options must contain:
-The name course directory is set to $newCourseID.
+ courseID => $courseID,
+ ce => $ce,
+ dbOptions => $dbOptions,
+ newCourseID => $newCourseID,
+
+Rename the course named $courseID to $newCourseID.
+
+$ce is a WeBWorK::CourseEnvironment object that describes the existing course's
+environment.
+
+$dbOptions is a reference to a hash containing information required to create
+the course's new database and delete the course's old database.
+
+ if dbLayout == "sql":
+
+ host => host to connect to
+ port => port to connect to
+ username => user to connect as (must have CREATE, DELETE, FILE, INSERT,
+ SELECT, UPDATE privileges, WITH GRANT OPTION.)
+ password => password to supply
+ old_database => the name of the database to delete
+ new_database => the name of the database to create
+ wwhost => the host from which the webwork database users will be allowed
+ to connect. (if host is set to localhost, this should be set to
+ localhost too.)
+
+The name of the course's directory is changed to $newCourseID.
+
+If the course's database layout is C<sql_single>, new tables are created in the
+current database, course data is copied from the old tables to the new tables,
+and the old tables are deleted.
If the course's database layout is C<sql>, a new database is created, course
-data is exported from the old database and imported into the new database, and
-the old database is deleted.
+data is copied from the old database to the new database, and the old database
+is deleted.
If the course's database layout is C<gdbm>, the DBM files are simply renamed on
disk.
@@ -253,9 +283,108 @@
=cut
sub renameCourse {
- my ($webworkRoot, $oldCourseID, $newCourseID) = @_;
+ my (%options) = @_;
+
+ # renameCourseHelper needs:
+ # $fromCourseID ($oldCourseID)
+ # $fromCE ($oldCE)
+ # $toCourseID ($newCourseID)
+ # $toCE (construct from $oldCE)
+ # $dbLayoutName ($oldCE->{dbLayoutName})
+ # %options ($dbOptions)
+
+ my $oldCourseID = $options{courseID};
+ my $oldCE = $options{ce};
+ my %dbOptions = defined $options{dbOptions} ? %{ $options{dbOptions} } : ();
+ my $newCourseID = $options{newCourseID};
+
+ # get the database layout out of the options hash
+ my $dbLayoutName = $oldCE->{dbLayoutName};
+
+ die "I happen to know that renameCourse() will only succeed for sql_single courses. Bug sam to write support for gdbm and sql courses.\n"
+ unless $dbLayoutName eq "sql_single";
+
+ # collect some data
+ my $coursesDir = $oldCE->{webworkDirs}->{courses};
+ my $oldCourseDir = "$coursesDir/$oldCourseID";
+ my $newCourseDir = "$coursesDir/$newCourseID";
+
+ # fail if the target course already exists
+ if (-e $newCourseDir) {
+ croak "$newCourseID: course exists";
+ }
+
+ # fail if the source course does not exist
+ unless (-e $oldCourseDir) {
+ croak "$oldCourseID: course not found";
+ }
+
+ ##### step 1: move course directory #####
- return 0;
+ # move top-level course directory
+ my $mvCmd = $oldCE->{externalPrograms}->{mv};
+ debug("moving course dir: $mvCmd $oldCourseDir $newCourseDir\n");
+ my $mvResult = system $mvCmd, $oldCourseDir, $newCourseDir;
+ $mvResult and die "failed to move course directory with command: '$mvCmd $oldCourseDir $newCourseDir' (errno: $mvResult): $!\n";
+
+ # get new course environment
+ my $newCE = $oldCE->new(
+ $oldCE->{webworkDirs}->{root},
+ $oldCE->{webworkURLs}->{root},
+ $oldCE->{pg}->{directories}->{root},
+ $newCourseID,
+ );
+
+ # find the course dirs that still exist in their original locations
+ # (i.e. are not subdirs of $courseDir)
+ my %oldCourseDirs = %{ $oldCE->{courseDirs} };
+ 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};
+ if (-e $oldDir) {
+ debug("oldDir $oldDir still exists. might move it...\n");
+ 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";
+ }
+ } else {
+ debug("oldDir $oldDir was already moved.\n");
+ }
+ }
+
+ ##### step 2: create new database #####
+
+ # munge DB options to move new_database => database
+ my %createDBOptions = %dbOptions;
+ if (exists $createDBOptions{new_database}) {
+ $createDBOptions{database} = $createDBOptions{new_database};
+ delete $createDBOptions{new_database};
+ }
+
+ my $createHelperResult = addCourseHelper($oldCourseID, $newCE, $dbLayoutName, %dbOptions);
+ die "$oldCourseID: course database creation failed.\n" unless $createHelperResult;
+
+ ##### step 3: copy course data #####
+
+ my $copyCourseDataResult = copyCourseDataHelper($oldCourseID, $oldCE, $newCourseID, $newCE, $dbLayoutName, %dbOptions);
+ die "$oldCourseID: failed to copy course data from $oldCourseID to $newCourseID.\n" unless $copyCourseDataResult;
+
+ ##### step 4: delete old database #####
+
+ # munge DB options to move old_database => database
+ my %deleteDBOptions = %dbOptions;
+ if (exists $deleteDBOptions{old_database}) {
+ $deleteDBOptions{database} = $deleteDBOptions{old_database};
+ delete $deleteDBOptions{old_database};
+ }
+
+ my $deleteHelperResult = deleteCourseHelper($oldCourseID, $newCE, $dbLayoutName, %dbOptions);
+ die "$oldCourseID: course database creation failed.\n" unless $deleteHelperResult;
}
=item deleteCourse(%options)
@@ -282,7 +411,7 @@
username => user to connect as (must have CREATE, DELETE, FILE, INSERT,
SELECT, UPDATE privileges, WITH GRANT OPTION.)
password => password to supply
- database => the name of the database to create
+ database => the name of the database to delete
Deletes the course named $courseID. The course directory is removed.
@@ -392,11 +521,9 @@
=head1 DATABASE-LAYOUT SPECIFIC HELPER FUNCTIONS
-The addCourseHelper(), renameCourseHelper(), and deleteCourseHelper() functions
-are used by addCourse(), renameCourse(), and deleteCourse() to perform
-database-layout specific operations, such as creating a database. They are
-called after the course directory structure has been created, but before the
-database is initialized.
+The addCourseHelper(), copyCourseDataHelper(), and deleteCourseHelper()
+functions are used to perform database-layout specific operations, such as
+creating a database.
The implementations in this class do nothing, but if an appropriate function
exists in a class with the name
@@ -411,18 +538,21 @@
=cut
sub addCourseHelper {
- my $result = callHelperIfExists("addCourseHelper", @_);
+ my ($courseID, $ce, $dbLayoutName, %options) = @_;
+ my $result = callHelperIfExists("addCourseHelper", $dbLayoutName, @_);
return $result;
}
-=item renameCourseHelper($oldCourseID, $newCourseID, $ce, $dbLayoutName, %options)
+=item copyCourseDataHelper($fromCourseID, $fromCE, $toCourseID, $toCE, $dbLayoutName, %options)
-Perform database-layout specific operations for renaming a course.
+Perform database-layout specific operations for copying a course's data from one
+database to another.
=cut
-sub renameCourseHelper {
- return callHelperIfExists("renameCourseHelper", @_);
+sub copyCourseDataHelper {
+ my ($fromCourseID, $fromCE, $toCourseID, $toCE, $dbLayoutName, %options) = @_;
+ return callHelperIfExists("copyCourseDataHelper", $dbLayoutName, @_);
}
=item deleteCourseHelper($courseID, $ce, $dbLayoutName, %options)
@@ -432,7 +562,8 @@
=cut
sub deleteCourseHelper {
- return callHelperIfExists("deleteCourseHelper", @_);
+ my ($courseID, $ce, $dbLayoutName, %options) = @_;
+ return callHelperIfExists("deleteCourseHelper", $dbLayoutName, @_);
}
=back
@@ -448,7 +579,7 @@
=over
-=item callHelperIfExists($helperName, $args)
+=item callHelperIfExists($helperName, $dbLayoutName, @args)
Call a database-specific helper function, if a database-layout specific helper
class exists and contains a function named "${helperName}Helper".
@@ -456,8 +587,7 @@
=cut
sub callHelperIfExists {
- my $helperName = shift;
- my ($courseID, $ce, $dbLayoutName, %options) = @_;
+ my ($helperName, $dbLayoutName, @args) = @_;
my $result;
@@ -476,7 +606,7 @@
my %syms = do { no strict 'refs'; %{$package."::"} };
if (exists $syms{$helperName}) {
my $func = do { no strict 'refs'; \&{$package."::".$helperName} };
- $result = $func->(@_);
+ $result = $func->(@args);
} else {
#warn "No helper defined for operation '$helperName'.\n";
$result = 1;
Index: sql_single.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils/CourseManagement/sql_single.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -u -r1.3 -r1.4
--- lib/WeBWorK/Utils/CourseManagement/sql_single.pm
+++ lib/WeBWorK/Utils/CourseManagement/sql_single.pm
@@ -25,9 +25,11 @@
use strict;
use warnings;
+use Data::Dumper;
use DBI;
use WeBWorK::Debug;
use WeBWorK::Utils qw(runtime_use undefstr);
+use WeBWorK::Utils::CourseManagement qw/dbLayoutSQLSources/;
=head1 HELPER FUNCTIONS
@@ -160,6 +162,148 @@
}
$dbh->disconnect;
+
+ return 1;
+}
+
+=item renameCourseHelper($fromCourseID, $fromCE, $toCourseID, $toCE, $dbLayoutName, %options)
+
+Uses addCourseHelper() to create a new course database on the same server.
+Copies the data from the old course database to the new one. Uses
+deleteCourseHelper() to delete the old course database.
+
+=cut
+
+sub copyCourseDataHelper {
+ my ($fromCourseID, $fromCE, $toCourseID, $toCE, $dbLayoutName, %options) = @_;
+ debug("fromCourseID=$fromCourseID, fromCE=$fromCE toCourseID=$toCourseID toCE=$toCE dbLayoutName=$dbLayoutName\n");
+
+ ##### get list of tables to copy data FROM #####
+
+ my $fromDBLayout = $fromCE->{dbLayouts}->{$dbLayoutName};
+ debug("fromDBLayout=$fromDBLayout\n");
+ my %fromSources = dbLayoutSQLSources($fromDBLayout);
+ debug("fromSources: ", Dumper(\%fromSources));
+ my $fromSource = mostPopularSource(%fromSources);
+ debug("fromSource=$fromSource\n");
+ my %fromSource = %{ $fromSources{$fromSource} };
+ my @fromTables = @{ $fromSource{tables} };
+ my $fromUsername = $fromSource{username};
+ my $fromPassword = $fromSource{password};
+
+ ##### get list of tables to copy data TO #####
+
+ my $toDBLayout = $toCE->{dbLayouts}->{$dbLayoutName};
+ my %toSources = dbLayoutSQLSources($toDBLayout);
+ my $toSource = mostPopularSource(%toSources);
+ my %toSource = %{ $toSources{$toSource} };
+ my @toTables = @{ $toSource{tables} };
+ my $toUsername = $toSource{username};
+ my $toPassword = $toSource{password};
+
+ ##### make sure the same tables are present in each list #####
+
+ my %fromTables; @fromTables{@fromTables} = ();
+
+ foreach my $toTable (@toTables) {
+ if (exists $fromTables{$toTable}) {
+ # present in both
+ delete $fromTables{$toTable};
+ } else {
+ die "Table '$toTable' exists in \@toTables but not in \@fromTables. Can't continue";
+ }
+ }
+
+ if (keys %fromTables) {
+ my @leftovers = keys %fromTables;
+ die "Tables '@leftovers' exist in \@fromTables but not in \@toTables. Can't continue";
+ }
+
+ if ($fromUsername ne $toUsername) {
+ die "Usernames for from/to sources don't match. Can't continue";
+ }
+
+ if ($fromPassword ne $toPassword) {
+ die "Passwords for from/to sources don't match. Can't continue";
+ }
+
+ ##### consruct SQL statements to copy the data in each table #####
+
+ my @stmts;
+
+ foreach my $table (@fromTables) {
+ debug("Table: $table\n");
+ my $fromTable = do {
+ my $fromParamsRef = $fromDBLayout->{$table}->{params};
+ if ($fromParamsRef) {
+ if (exists $fromParamsRef->{tableOverride}) {
+ $fromParamsRef->{tableOverride}
+ } else {
+ ""; # no override
+ }
+ } else {
+ ""; # no params
+ }
+ } || $table;
+ debug("sql \"from\" table name: $fromTable\n");
+
+ my $toTable = do {
+ my $toParamsRef = $toDBLayout->{$table}->{params};
+ if ($toParamsRef) {
+ if (exists $toParamsRef->{tableOverride}) {
+ $toParamsRef->{tableOverride};
+ } else {
+ ""; # no override
+ }
+ } else {
+ ""; # no params
+ }
+ } || $table;
+ debug("sql \"to\" table name: $toTable\n");
+
+ my $stmt = "INSERT INTO `$toTable` SELECT * FROM `$fromTable`";
+ debug("stmt = $stmt\n");
+ push @stmts, $stmt;
+ }
+
+ ##### issue SQL statements #####
+
+ my $dbh = DBI->connect($fromSource, $fromUsername, $fromPassword);
+ unless (defined $dbh) {
+ die "sql_single: failed to connect to DBI source '$fromSource': $DBI::errstr\n";
+ }
+
+ foreach my $stmt (@stmts) {
+ my $rows = $dbh->do($stmt);
+ unless (defined $rows) {
+ die "sql_single: failed to execute SQL statement '$stmt': $DBI::errstr\n";
+ }
+ }
+
+ $dbh->disconnect;
+
+ return 1;
+}
+
+# returns the name of the source with the most tables
+sub mostPopularSource {
+ my (%sources) = @_;
+
+ my $source;
+ if (keys %sources > 1) {
+ # more than one -- warn and select the most popular source
+ debug("more than one SQL source defined.\n");
+ foreach my $curr (keys %sources) {
+ $source = $curr if not defined $source or @{ $sources{$curr}->{tables} } > @{ $sources{$source}->{tables} };
+ }
+ debug("only handling tables with source \"$source\".\n");
+ debug("others will have to be handled manually (or not at all).\n");
+ } else {
+ # there's only one
+ ($source) = keys %sources;
+ }
+
+ return $source;
}
=item deleteCourseHelper($courseID, $ce, $dbLayoutName, %options)
@@ -270,6 +414,8 @@
}
$dbh->disconnect;
+
+ return 1;
}
=back
|
