Parent Directory
| 
Revision Log
add localizing files -- merge with trunk
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/Utils/CourseManagement.pm,v 1.48 2009/10/01 21:28:46 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::Utils::CourseManagement; 18 use base qw(Exporter); 19 20 =head1 NAME 21 22 WeBWorK::Utils::CourseManagement - create, rename, and delete courses. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use Carp; 29 use DBI; 30 use File::Path qw(rmtree); 31 use File::Spec; 32 use String::ShellQuote; 33 use WeBWorK::CourseEnvironment; 34 use WeBWorK::Debug; 35 use WeBWorK::Utils qw(runtime_use readDirectory pretty_print_rh); 36 use UUID::Tiny qw(create_uuid_as_string); 37 #use WeBWorK::Utils::DBUpgrade; 38 use PGcore; # for not_null() macro 39 40 our @EXPORT = (); 41 our @EXPORT_OK = qw( 42 listCourses 43 listArchivedCourses 44 addCourse 45 renameCourse 46 deleteCourse 47 archiveCourse 48 unarchiveCourse 49 dbLayoutSQLSources 50 initNonNativeTables 51 52 ); 53 54 # checkCourseTables 55 # updateCourseTables 56 # checkCourseDirectories 57 58 =head1 FUNCTIONS 59 60 =over 61 62 =cut 63 64 ################################################################################ 65 66 =item listCourses($ce) 67 68 Lists the courses defined. 69 70 =cut 71 72 sub listCourses { 73 my ($ce) = @_; 74 my $coursesDir = $ce->{webworkDirs}->{courses}; 75 return grep { not (m/^\./ or m/^CVS$/) and -d "$coursesDir/$_" } readDirectory($coursesDir); 76 } 77 78 =item listArchivedCourses($ce) 79 80 Lists the courses which have been archived (end in .tar.gz). 81 82 =cut 83 84 sub listArchivedCourses { 85 my ($ce) = @_; 86 my $coursesDir = $ce->{webworkDirs}->{courses}; 87 return grep { m/\.tar\.gz$/ } readDirectory($coursesDir); 88 } 89 90 ################################################################################ 91 92 =item addCourse(%options) 93 94 %options must contain: 95 96 courseID => $courseID, 97 ce => $ce, 98 courseOptions => $courseOptions, 99 dbOptions => $dbOptions, 100 users => $users 101 102 %options may contain: 103 104 templatesFrom => $templatesCourseID, 105 106 Create a new course named $courseID. 107 108 $ce is a WeBWorK::CourseEnvironment object that describes the new course's 109 environment. 110 111 $courseOptions is a reference to a hash containing the following options: 112 113 dbLayoutName => $dbLayoutName 114 allowedRecipients => $mail{allowedRecipients} 115 feedbackRecipients => $mail{feedbackRecipients} 116 PRINT_FILE_NAMES_FOR => $pg{specialPGEnvironmentVars}->{PRINT_FILE_NAMES_FOR} 117 118 C<dbLayoutName> is required. C<allowedRecipients>, C<feedbackRecipients>, and 119 C<PRINT_FILE_NAMES_FOR> are references to arrays. 120 121 $dbOptions is a reference to a hash containing information required to create a 122 database for the course. Current database layouts do not require additional 123 information, so specify a reference to an empty hash. If $dbOptions is 124 undefined, addCourse() assumes that the database has already been created, and 125 skips that step in the course creation process. 126 127 $users is a list of arrayrefs, each containing a User, Password, and 128 PermissionLevel record for a single user: 129 130 $users = [ $User, $Password, $PermissionLevel ] 131 132 These users are added to the course. 133 134 $templatesCourseID indicates the ID of a course from which the contents of the 135 templates directory will be copied to the new course. 136 137 =cut 138 139 sub addCourse { 140 my (%options) = @_; 141 142 my $courseID = $options{courseID}; 143 my $ce = $options{ce}; 144 my %courseOptions = %{ $options{courseOptions} }; 145 my %dbOptions = defined $options{dbOptions} ? %{ $options{dbOptions} } : (); 146 my @users = exists $options{users} ? @{ $options{users} } : (); 147 148 # get the database layout out of the options hash 149 my $dbLayoutName = $courseOptions{dbLayoutName}; 150 151 # collect some data 152 my $coursesDir = $ce->{webworkDirs}->{courses}; 153 my $courseDir = "$coursesDir/$courseID"; 154 155 # fail if the course already exists 156 # IMPORTANT: this must be the first check! if any check other than this one 157 # fails, CourseAdmin deletes the course!! Oh no!!! 158 # DO NOT CHANGE THE DIE MESSAGE -- CourseAdmin checks it to determine whether 159 # a course was partially created and should be deleted! 160 # FIXME -- this is bad, and addCourse should deal with cleaning up partially 161 # created courses itself 162 if (-e $courseDir) { 163 croak "$courseID: course exists"; 164 } 165 166 # fail if the course ID contains invalid characters 167 croak "Invalid characters in course ID: '$courseID' (valid characters are [-A-Za-z0-9_])" 168 unless $courseID =~ m/^[-A-Za-z0-9_]*$/; 169 170 # if we didn't get a database layout, use the default one 171 if (not defined $dbLayoutName) { 172 $dbLayoutName = $ce->{dbLayoutName}; 173 } 174 175 # fail if the database layout is invalid 176 if (not exists $ce->{dbLayouts}->{$dbLayoutName}) { 177 croak "$dbLayoutName: not found in \%dbLayouts"; 178 } 179 180 ##### step 1: create course directory structure ##### 181 182 my %courseDirs = %{$ce->{courseDirs}}; 183 184 # deal with root directory first -- if we can't create it, we have to give up. 185 186 exists $courseDirs{root} or croak "Can't create the course '$courseID' because no root directory is specified in the '%courseDirs' hash."; 187 my $root = $courseDirs{root}; 188 delete $courseDirs{root}; 189 { 190 # does the directory already exist? 191 -e $root and croak "Can't create the course '$courseID' because the root directory '$root' already exists."; 192 # is the parent directory writeable? 193 my @rootElements = File::Spec->splitdir($root); 194 pop @rootElements; 195 my $rootParent = File::Spec->catdir(@rootElements); 196 -w $rootParent or croak "Can't create the course '$courseID' because the courses directory '$rootParent' is not writeable."; 197 # try to create it 198 mkdir $root or croak "Can't create the course '$courseID' becasue the root directory '$root' could not be created: $!."; 199 } 200 201 # deal with the rest of the directories 202 203 my @courseDirNames = sort { $courseDirs{$a} cmp $courseDirs{$b} } keys %courseDirs; 204 foreach my $courseDirName (@courseDirNames) { 205 my $courseDir = File::Spec->canonpath($courseDirs{$courseDirName}); 206 207 # does the directory already exist? 208 if (-e $courseDir) { 209 warn "Can't create $courseDirName directory '$courseDir', since it already exists. Using existing directory.\n"; 210 next; 211 } 212 213 # is the parent directory writeable? 214 my @courseDirElements = File::Spec->splitdir($courseDir); 215 pop @courseDirElements; 216 my $courseDirParent = File::Spec->catdir(@courseDirElements); 217 unless (-w $courseDirParent) { 218 warn "Can't create $courseDirName directory '$courseDir', since the parent directory is not writeable. You will have to create this directory manually.\n"; 219 next; 220 } 221 222 # try to create it 223 mkdir $courseDir or warn "Failed to create $courseDirName directory '$courseDir': $!. You will have to create this directory manually.\n"; 224 } 225 226 ##### step 2: create course database ##### 227 228 my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); 229 my $create_db_result = $db->create_tables; 230 die "$courseID: course database creation failed.\n" unless $create_db_result; 231 232 ##### step 3: populate course database ##### 233 234 if ($ce->{dbLayouts}{$dbLayoutName}{user}{params}{non_native}) { 235 debug("not adding users to the course database: 'user' table is non-native.\n"); 236 } else { 237 # see above 238 #my $db = WeBWorK::DB->new($ce->{dbLayouts}->{$dbLayoutName}); 239 240 foreach my $userTriple (@users) { 241 my ($User, $Password, $PermissionLevel) = @$userTriple; 242 243 eval { $db->addUser($User) }; warn $@ if $@; 244 eval { $db->addPassword($Password) }; warn $@ if $@; 245 eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; 246 } 247 } 248 249 ##### step 4: write course.conf file ##### 250 251 my $courseEnvFile = $ce->{courseFiles}->{environment}; 252 open my $fh, ">", $courseEnvFile 253 or die "failed to open $courseEnvFile for writing.\n"; 254 writeCourseConf($fh, $ce, %courseOptions); 255 close $fh; 256 257 ##### step 5: copy templates ##### 258 259 if (exists $options{templatesFrom}) { 260 my $sourceCourse = $options{templatesFrom}; 261 my $sourceCE = new WeBWorK::CourseEnvironment({ 262 get_SeedCE($ce), 263 courseName => $sourceCourse, # override courseName 264 }); 265 my $sourceDir = $sourceCE->{courseDirs}->{templates}; 266 267 if (-d $sourceDir) { 268 my $destDir = $ce->{courseDirs}{templates}; 269 my $cp_cmd = "2>&1 " . $ce->{externalPrograms}{cp} . " -R " . shell_quote($sourceDir) . "/* " . shell_quote($destDir); 270 my $cp_out = readpipe $cp_cmd; 271 if ($?) { 272 my $exit = $? >> 8; 273 my $signal = $? & 127; 274 my $core = $? & 128; 275 warn "Failed to copy templates from course '$sourceCourse' with command '$cp_cmd' (exit=$exit signal=$signal core=$core): $cp_out\n"; 276 } 277 } else { 278 warn "Failed to copy templates from course '$sourceCourse': templates directory '$sourceDir' does not exist.\n"; 279 } 280 } 281 } 282 283 ################################################################################ 284 285 =item renameCourse(%options) 286 287 %options must contain: 288 289 courseID => $courseID, 290 ce => $ce, 291 dbOptions => $dbOptions, 292 newCourseID => $newCourseID, 293 294 %options may also contain: 295 296 skipDBRename => $skipDBRename, 297 298 Rename the course named $courseID to $newCourseID. 299 300 $ce is a WeBWorK::CourseEnvironment object that describes the existing course's 301 environment. 302 303 $dbOptions is a reference to a hash containing information required to create 304 the course's new database and delete the course's old database. Current database 305 layouts do not require additional information, so specify a reference to an 306 empty hash. 307 308 The name of the course's directory is changed to $newCourseID. 309 310 If the course's database layout is C<sql_single> or C<sql_moodle>, new tables 311 are created in the current database, course data is copied from the old tables 312 to the new tables, and the old tables are deleted. 313 314 If the course's database layout is something else, no database changes are made. 315 316 If $skipDBRename is true, no database changes are made. This is useful if a 317 course is being unarchived and no database was found, or for renaming the 318 modelCourse. 319 320 Any errors encountered while renaming the course are returned. 321 322 =cut 323 324 sub renameCourse { 325 my (%options) = @_; 326 327 # renameCourseHelper needs: 328 # $fromCourseID ($oldCourseID) 329 # $fromCE ($oldCE) 330 # $toCourseID ($newCourseID) 331 # $toCE (construct from $oldCE) 332 # $dbLayoutName ($oldCE->{dbLayoutName}) 333 # %options ($dbOptions) 334 335 my $oldCourseID = $options{courseID}; 336 my $oldCE = $options{ce}; 337 my %dbOptions = defined $options{dbOptions} ? %{ $options{dbOptions} } : (); 338 my $newCourseID = $options{newCourseID}; 339 my $skipDBRename = $options{skipDBRename} || 0; 340 341 # get the database layout out of the options hash 342 my $dbLayoutName = $oldCE->{dbLayoutName}; 343 344 # collect some data 345 my $coursesDir = $oldCE->{webworkDirs}->{courses}; 346 my $oldCourseDir = "$coursesDir/$oldCourseID"; 347 my $newCourseDir = "$coursesDir/$newCourseID"; 348 349 # fail if the target course already exists 350 if (-e $newCourseDir) { 351 croak "$newCourseID: course exists"; 352 } 353 354 # fail if the source course does not exist 355 unless (-e $oldCourseDir) { 356 croak "$oldCourseID: course not found"; 357 } 358 359 ##### step 1: move course directory ##### 360 361 # move top-level course directory 362 my $mv_cmd = "2>&1"." ".$oldCE->{externalPrograms}{mv}." ".shell_quote($oldCourseDir)." ".shell_quote($newCourseDir); 363 debug("moving course dir: $mv_cmd"); 364 my $mv_out = readpipe $mv_cmd; 365 if ($?) { 366 my $exit = $? >> 8; 367 my $signal = $? & 127; 368 my $core = $? & 128; 369 die "Failed to move course directory with command '$mv_cmd' (exit=$exit signal=$signal core=$core): $mv_out\n"; 370 } 371 372 # get new course environment 373 my $newCE = $oldCE->new( 374 $oldCE->{webworkDirs}->{root}, 375 $oldCE->{webworkURLs}->{root}, 376 $oldCE->{pg}->{directories}->{root}, 377 $newCourseID, 378 ); 379 380 # find the course dirs that still exist in their original locations 381 # (i.e. are not subdirs of $courseDir) 382 my %oldCourseDirs = %{ $oldCE->{courseDirs} }; 383 my %newCourseDirs = %{ $newCE->{courseDirs} }; 384 my @courseDirNames = sort { $oldCourseDirs{$a} cmp $oldCourseDirs{$b} } keys %oldCourseDirs; 385 foreach my $courseDirName (@courseDirNames) { 386 my $oldDir = File::Spec->canonpath($oldCourseDirs{$courseDirName}); 387 my $newDir = File::Spec->canonpath($newCourseDirs{$courseDirName}); 388 if (-e $oldDir) { 389 debug("oldDir $oldDir still exists. might move it...\n"); 390 391 # check for a few likely error conditions, since the mv error is not that helpful 392 393 # is the source really a directory 394 unless (-d $oldDir) { 395 warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the source is not a directory. You will have to move this directory manually.\n"; 396 next; 397 } 398 399 # does the destination already exist? 400 # (this should only happen on extra-coursedir directories, since we make sure the root dir doesn't exist above.) 401 if (-e $newDir) { 402 warn "$courseDirName: Can't move '$oldDir' to '$newDir', since the target already exists. You will have to move this directory manually.\n"; 403 next; 404 } 405 406 # is oldDir's parent writeable 407 my @oldDirElements = File::Spec->splitdir($oldDir); 408 pop @oldDirElements; 409 my $oldDirParent = File::Spec->catdir(@oldDirElements); 410 unless (-w $oldDirParent) { 411 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"; 412 next; 413 } 414 415 # is newDir's parent writeable? 416 my @newDirElements = File::Spec->splitdir($newDir); 417 pop @newDirElements; 418 my $newDirParent = File::Spec->catdir(@newDirElements); 419 unless (-w $newDirParent) { 420 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"; 421 next; 422 } 423 424 # try to move the directory 425 debug("Going to move $oldDir to $newDir...\n"); 426 my $mv_cmd = "2>&1"." ".$oldCE->{externalPrograms}{mv}." ".shell_quote($oldDir)." ".shell_quote($newDir); 427 my $mv_out = readpipe $mv_cmd; 428 if ($?) { 429 my $exit = $? >> 8; 430 my $signal = $? & 127; 431 my $core = $? & 128; 432 warn "Failed to move directory with command '$mv_cmd' (exit=$exit signal=$signal core=$core): $mv_out\n"; 433 } 434 } else { 435 debug("oldDir $oldDir was already moved.\n"); 436 } 437 } 438 439 ##### step 2: rename database ##### 440 441 unless ($skipDBRename) { 442 my $oldDB = new WeBWorK::DB($oldCE->{dbLayouts}{$dbLayoutName}); 443 my $rename_db_result = $oldDB->rename_tables($newCE->{dbLayouts}{$dbLayoutName}); 444 die "$oldCourseID: course database renaming failed.\n" unless $rename_db_result; 445 } 446 } 447 448 ################################################################################ 449 450 =item deleteCourse(%options) 451 452 Options must contain: 453 454 courseID => $courseID, 455 ce => $ce, 456 dbOptions => $dbOptions, 457 458 $ce is a WeBWorK::CourseEnvironment object that describes the course's 459 environment. It is your responsability to pass a course environment object that 460 describes the course to be deleted. Do not pass the course environment object 461 associated with the request, unless you are deleting the course you're currently 462 using. 463 464 $dbOptions is a reference to a hash containing information required to delete 465 the database for the course. Current database layouts do not require additional 466 information, so specify a reference to an empty hash. If $dbOptions is 467 undefined, addCourse() assumes that the database has already been deleted, and 468 skips that step in the course deletion process. 469 470 Deletes the course named $courseID. The course directory is removed. 471 472 Any errors encountered while deleting the course are returned. 473 474 =cut 475 476 sub deleteCourse { 477 my (%options) = @_; 478 479 my $courseID = $options{courseID}; 480 my $ce = $options{ce}; 481 my %dbOptions = defined $options{dbOptions} ? %{ $options{dbOptions} } : (); 482 483 # make sure the user isn't brain damaged 484 die "the course environment supplied doesn't appear to describe the course $courseID. can't proceed." 485 unless $ce->{courseName} eq $courseID; 486 487 my %courseDirs = %{$ce->{courseDirs}}; 488 489 ##### step 0: make sure course directory is deleteable ##### 490 491 # deal with root directory first -- if we won't be able to delete it, we have to give up. 492 493 exists $courseDirs{root} or croak "Can't delete the course '$courseID' because no root directory is specified in the '%courseDirs' hash."; 494 my $root = $courseDirs{root}; 495 if (-e $root) { 496 # is the parent directory writeable? 497 my @rootElements = File::Spec->splitdir($root); 498 pop @rootElements; 499 my $rootParent = File::Spec->catdir(@rootElements); 500 -w $rootParent or croak "Can't delete the course '$courseID' because the courses directory '$rootParent' is not writeable."; 501 } else { 502 warn "Warning: the course root directory '$root' does not exist. Attempting to delete the course database and other course directories...\n"; 503 } 504 505 ##### step 1: delete course database (if necessary) ##### 506 507 my $dbLayoutName = $ce->{dbLayoutName}; 508 my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); 509 my $create_db_result = $db->delete_tables; 510 die "$courseID: course database deletion failed.\n" unless $create_db_result; 511 512 ##### step 2: delete course directory structure ##### 513 514 my @courseDirNames = sort { $courseDirs{$a} cmp $courseDirs{$b} } keys %courseDirs; 515 foreach my $courseDirName (@courseDirNames) { 516 my $courseDir = File::Spec->canonpath($courseDirs{$courseDirName}); 517 if (-e $courseDir) { 518 debug("courseDir $courseDir still exists. might delete it...\n"); 519 520 # check for a few likely error conditions, since the mv error is not that helpful 521 522 # is it really a directory 523 unless (-d $courseDir) { 524 warn "Can't delete $courseDirName directory '$courseDir', since is not a directory. If it is not wanted, you will have to delete it manually.\n"; 525 next; 526 } 527 528 # is the parent writeable 529 my @courseDirElements = File::Spec->splitdir($courseDir); 530 pop @courseDirElements; 531 my $courseDirParent = File::Spec->catdir(@courseDirElements); 532 unless (-w $courseDirParent) { 533 warn "Can't delete $courseDirName directory '$courseDir', since its parent directory is not writeable. If it is not wanted, you will have to delete it manually.\n"; 534 next; 535 } 536 537 # try to delete the directory 538 debug("Going to delete $courseDir...\n"); 539 rmtree($courseDir, 0, 1); 540 } else { 541 debug("courseDir $courseDir was already deleted.\n"); 542 } 543 } 544 } 545 546 ################################################################################ 547 548 =item archiveCourse(%options) 549 550 %options must contain: 551 552 courseID => $courseID, 553 ce => $ce, 554 555 Creates a gzipped tar archive (.tar.gz) of the course $courseID in the WeBWorK 556 courses directory. Before archiving, the course database is dumped into a 557 subdirectory of the course's DATA directory. 558 559 Only files and directories stored directly in the course directory are archived. 560 The contents of linked files is not archived although the symbolic links 561 themselves are saved. 562 563 $courseID is the name of the course to archive. 564 565 $ce is a WeBWorK::CourseEnvironment object that describes the course's 566 environment. (This is used to access the course database and get path 567 information.) 568 569 If an error occurs, an exception is thrown. 570 571 =cut 572 573 sub archiveCourse { 574 my (%options) = @_; 575 my $courseID = $options{courseID}; 576 my $ce = $options{ce}; 577 578 # make sure the user isn't brain damaged 579 croak "The course environment supplied doesn't appear to match the course $courseID. Can't proceed" 580 unless $ce->{courseName} eq $courseID; 581 582 # grab some values we'll need 583 my $course_dir = $ce->{courseDirs}{root}; 584 585 # tmp_archive_path is used as the target of the tar.gz operation 586 # After this is done the final tar.gz file is moved either to the course directory 587 # or the course/myCourse/templates directory (when saving individual courses) 588 # this prevents us from tarring a directory to which we have just added a file 589 # see bug #2022 -- for error messages on some operating systems 590 my $uuidStub = create_uuid_as_string(); 591 my $tmp_archive_path = $ce->{webworkDirs}{courses} . "/ ${uuidStub}_$courseID.tar.gz"; 592 my $data_dir = $ce->{courseDirs}{DATA}; 593 my $dump_dir = "$data_dir/mysqldump"; 594 my $archive_path; 595 if ( PGcore::not_null( $options{archive_path} ) ) { 596 $archive_path = $options{archive_path}; 597 } else { 598 $archive_path = $ce->{webworkDirs}{courses} . "/$courseID.tar.gz"; 599 } 600 601 602 # fail if the source course does not exist 603 unless (-e $course_dir) { 604 croak "$courseID: course not found"; 605 } 606 607 # replace previous archived file if it exists. 608 if (-e $archive_path) { 609 unlink($archive_path) if (-w $archive_path); 610 unless (-e $archive_path) { 611 print CGI::p({-style=>'color:red; font-weight:bold'}, "The archival version of '$courseID' has been replaced'.\n"); 612 } else { 613 croak "Unable to replace the archival version of '$courseID'"; 614 } 615 } 616 617 #### step 1: dump tables ##### 618 619 unless (-e $dump_dir) { 620 mkdir $dump_dir or croak "Failed to create course database dump directory '$dump_dir': $!"; 621 } 622 623 my $db = new WeBWorK::DB($ce->{dbLayout}); 624 my $dump_db_result = $db->dump_tables($dump_dir); 625 unless ($dump_db_result) { 626 _archiveCourse_remove_dump_dir($ce, $dump_dir); 627 croak "$courseID: course database dump failed.\n"; 628 } 629 630 ##### step 2: tar and gzip course directory (including dumped database) ##### 631 632 # we want tar to run from the parent directory of the course directory 633 my $chdir_to = "$course_dir/.."; 634 635 my $tar_cmd = "2>&1 " . $ce->{externalPrograms}{tar} 636 . " -C " . shell_quote($chdir_to) 637 . " -czf " . shell_quote($tmp_archive_path) 638 . " " . shell_quote($courseID); 639 my $tar_out = readpipe $tar_cmd; 640 if ($?) { 641 my $exit = $? >> 8; 642 my $signal = $? & 127; 643 my $core = $? & 128; 644 _archiveCourse_remove_dump_dir($ce, $dump_dir); 645 croak "Failed to archive course directory '$course_dir' with command '$tar_cmd' (exit=$exit signal=$signal core=$core): $tar_out\n"; 646 } 647 648 ##### step 3: cleanup -- remove database dump files from course directory ##### 649 650 unless (-e $archive_path) { 651 rename $tmp_archive_path, $archive_path; 652 } else { 653 croak "Failed to create archived file at '$archive_path'. File already exists."; 654 unlink($tmp_archive_path); #clean up 655 } 656 _archiveCourse_remove_dump_dir($ce, $dump_dir); 657 } 658 659 sub _archiveCourse_remove_dump_dir { 660 my ($ce, $dump_dir) = @_; 661 my $rm_cmd = "2>&1 " . $ce->{externalPrograms}{rm} 662 . " -rf " . shell_quote($dump_dir); 663 my $rm_out = readpipe $rm_cmd; 664 if ($?) { 665 my $exit = $? >> 8; 666 my $signal = $? & 127; 667 my $core = $? & 128; 668 carp "Failed to remove course database dump directory '$dump_dir' with command '$rm_cmd' (exit=$exit signal=$signal core=$core): $rm_out\n"; 669 } 670 } 671 672 ################################################################################ 673 674 =item unarchiveCourse(%options) 675 676 %options must contain: 677 678 oldCourseID => $oldCourseID, 679 archivePath => $archivePath, 680 ce => $ce, 681 682 %options may also contain: 683 684 newCourseID => $newCourseID, 685 686 Restores course $oldCourseID from a gzipped tar archive (.tar.gz) located at 687 $archivePath. After unarchiving, the course database is restored from a 688 subdirectory of the course's DATA directory. 689 690 If $newCourseID is defined and differs from $oldCourseID, the course is renamed 691 after unarchiving. 692 693 $ce is a WeBWorK::CourseEnvironment object that describes the some course's 694 environment. (Usually this would be the admin course.) This is used to access 695 the course database and get path information. 696 697 If an error occurs, an exception is thrown. 698 699 =cut 700 701 sub unarchiveCourse { 702 my (%options) = @_; 703 704 my $newCourseID = $options{newCourseID}; 705 my $currCourseID = $options{oldCourseID}; 706 my $archivePath = $options{archivePath}; 707 my $ce = $options{ce}; 708 709 my $coursesDir = $ce->{webworkDirs}{courses}; 710 711 # Double check that the new course does not exist 712 if (-e "$coursesDir/$newCourseID") { 713 die "Cannot overwrite existing course $coursesDir/$newCourseID"; 714 } 715 716 ##### step 1: move a conflicting course away ##### 717 718 # if this function returns undef, it means there was no course in the way 719 my $restoreCourseData = _unarchiveCourse_move_away($ce, $currCourseID); 720 721 ##### step 2: crack open the tarball ##### 722 723 my $tar_cmd = "2>&1 " . $ce->{externalPrograms}{tar} 724 . " -C " . shell_quote($coursesDir) 725 . " -xzf " . shell_quote($archivePath); 726 my $tar_out = readpipe $tar_cmd; 727 if ($?) { 728 my $exit = $? >> 8; 729 my $signal = $? & 127; 730 my $core = $? & 128; 731 _unarchiveCourse_move_back($restoreCourseData); 732 die "Failed to unarchive course directory with command '$tar_cmd' (exit=$exit signal=$signal core=$core): $tar_out\n"; 733 } 734 735 ##### step 3: read the course environment for this course ##### 736 737 my $ce2 = new WeBWorK::CourseEnvironment({ 738 get_SeedCE($ce), 739 courseName => $currCourseID, 740 }); 741 742 # pull out some useful stuff 743 my $course_dir = $ce2->{courseDirs}{root}; 744 my $data_dir = $ce2->{courseDirs}{DATA}; 745 my $dump_dir = "$data_dir/mysqldump"; 746 my $old_dump_file = "$data_dir/${currCourseID}_mysql.database"; 747 748 ##### step 4: restore the database tables ##### 749 750 my $no_database; 751 my $restore_db_result = 1; 752 if (-e $dump_dir) { 753 my $db = new WeBWorK::DB($ce2->{dbLayout}); 754 $restore_db_result = $db->restore_tables($dump_dir); 755 } elsif (-e $old_dump_file) { 756 my $dbLayoutName = $ce2->{dbLayoutName}; 757 if (ref getHelperRef("unarchiveCourseHelper", $dbLayoutName)) { 758 eval { 759 $restore_db_result = unarchiveCourseHelper($currCourseID, $ce2, $dbLayoutName, 760 unarchiveDatabasePath=>$old_dump_file); 761 }; 762 if ($@) { 763 warn "failed to unarchive course database from dump file '$old_dump_file: $@\n"; 764 } 765 } else { 766 warn "course '$currCourseID' uses dbLayout '$dbLayoutName', which doesn't support restoring database tables. database tables will not be restored.\n"; 767 $no_database = 1; 768 } 769 } else { 770 warn "course '$currCourseID' has no database dump in its data directory (checked for $dump_dir and $old_dump_file). database tables will not be restored.\n"; 771 $no_database = 1; 772 } 773 774 unless ($restore_db_result) { 775 warn "database restore of course '$currCourseID' failed: the course will probably not be usable.\n"; 776 } 777 778 ##### step 5: delete dump_dir and/or old_dump_file ##### 779 780 if (-e $dump_dir) { 781 _archiveCourse_remove_dump_dir($ce, $dump_dir); 782 } 783 if (-e $old_dump_file) { 784 unlink $old_dump_file or carp "Failed to unlink course database dump file '$old_dump_file: $_\n"; 785 } 786 787 ##### step 6: rename course ##### 788 789 if (defined $newCourseID and $newCourseID ne $currCourseID) { 790 renameCourse( 791 courseID => $currCourseID, 792 ce => $ce2, 793 newCourseID => $newCourseID, 794 skipDBRename => $no_database, 795 ); 796 } 797 798 ##### step 7: return conflicting course to its rightful place ##### 799 800 _unarchiveCourse_move_back($restoreCourseData); 801 } 802 803 sub _unarchiveCourse_move_away { 804 my ($ce, $courseID) = @_; 805 806 # course environment for before the course is moved 807 my $ce2 = new WeBWorK::CourseEnvironment({ 808 get_SeedCE($ce), 809 courseName => $courseID, 810 }); 811 812 # if course directory doesn't exist, we don't have to do anything 813 return unless -e $ce2->{courseDirs}{root}; 814 815 # temporary name for course 816 my $tmpCourseID = "${courseID}_tmp"; 817 818 debug("Temporarily moving $courseID to $tmpCourseID to make room for course unarchiving"); 819 renameCourse( 820 courseID => $courseID, 821 ce => $ce2, 822 newCourseID => $tmpCourseID, 823 ); 824 825 # course environment for after the course is moved 826 my $ce3 = new WeBWorK::CourseEnvironment({ 827 get_SeedCE($ce), 828 courseName => $tmpCourseID, 829 }); 830 831 # data to pass to renameCourse when moving the course back to it's original name 832 my $restore_course_data = { 833 courseID => $tmpCourseID, 834 ce => $ce3, # course environment for moved course 835 newCourseID => $courseID, 836 }; 837 838 return $restore_course_data; 839 } 840 841 sub _unarchiveCourse_move_back { 842 my ($restore_course_data) = @_; 843 844 return unless $restore_course_data; 845 846 debug("Moving $$restore_course_data{courseID} back to $$restore_course_data{newCourseID} after course unarchiving"); 847 renameCourse(%$restore_course_data); 848 } 849 850 ################################################################################ 851 852 =item dbLayoutSQLSources($dbLayout) 853 854 Retrun a hash of database sources for the sql and sql_single database layouts. 855 Each element of the hash takes this form: 856 857 dbi_source => { 858 tables => [ 'table1', 'table2', ... ], 859 username => 'username', 860 password => 'password', 861 } 862 863 In the common case, there will only be one source returned. 864 865 =cut 866 867 sub dbLayoutSQLSources { 868 my ($dbLayout) = @_; 869 870 my %dbLayout = %$dbLayout; 871 my @tables = keys %dbLayout; 872 873 my %sources; 874 875 foreach my $table (@tables) { 876 my %table = %{ $dbLayout{$table} }; 877 my %params = %{ $table{params} }; 878 879 if ($params{non_native}) { 880 debug("$table: marked non-native, skipping\n"); 881 next; 882 } 883 884 my $source = $table{source}; 885 my $username = $params{username}; 886 my $password = $params{password}; 887 888 push @{$sources{$source}{tables}}, $table; 889 890 if (defined $sources{$source}{username}) { 891 if ($sources{$source}{username} ne $username) { 892 warn "conflicting usernames for source '$source':", 893 " '$sources{$source}{username}', '$username'\n"; 894 } else { 895 # it's all good 896 } 897 } else { 898 $sources{$source}{username} = $username; 899 } 900 901 if (defined $sources{$source}{password}) { 902 if ($sources{$source}{password} ne $password) { 903 warn "conflicting passwords for source '$source':", 904 " '$sources{$source}{password}', '$password'\n"; 905 } else { 906 # it's all good 907 } 908 } else { 909 $sources{$source}{password} = $password; 910 } 911 } 912 913 return %sources; 914 } 915 916 =back 917 918 =cut 919 920 ################################################################################ 921 # database helpers 922 ################################################################################ 923 924 =head1 DATABASE-LAYOUT SPECIFIC HELPER FUNCTIONS 925 926 These functions are used to perform database-layout specific operations. 927 928 The implementations in this class do nothing, but if an appropriate function 929 exists in a class with the name 930 WeBWorK::Utils::CourseManagement::I<$dbLayoutName>, it will be used instead. 931 932 =over 933 934 =item archiveCourseHelper($courseID, $ce, $dbLayoutName, %options) 935 936 Perform database-layout specific operations for archiving the data in a course. 937 938 =cut 939 940 sub archiveCourseHelper { 941 my ($courseID, $ce, $dbLayoutName, %options) = @_; 942 my $result = callHelperIfExists("archiveCourseHelper", $dbLayoutName, @_); 943 return $result; 944 } 945 946 =item unarchiveCourseHelper($courseID, $ce, $dbLayoutName, %options) 947 948 Perform database-layout specific operations for unarchiving the data in a course 949 and placing it in the database. 950 951 =cut 952 953 sub unarchiveCourseHelper { 954 my ($courseID, $ce, $dbLayoutName, %options) = @_; 955 my $result = callHelperIfExists("unarchiveCourseHelper", $dbLayoutName, @_); 956 return $result; 957 } 958 959 =item initNonNativeTables($ce, $db, $dbLayoutName, %options) 960 961 Perform database-layout specific operations for initializing non-native database tables 962 that are not associated with a particular course 963 964 =cut 965 966 sub initNonNativeTables { 967 my($ce, $dbLayoutName, %options) = @_; 968 my $str = ''; 969 # Create a database handler 970 my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); 971 972 # lock database 973 974 # Find the names of the non-native database tables 975 foreach my $table (sort keys %$db) { 976 next unless $db->{$table}{params}{non_native}; # only look at non-native tables 977 my $database_table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table; 978 #warn "table is $table"; 979 #warn "checking $database_table_name"; 980 my $database_table_exists = ($db->{$table}->tableExists) ? 1:0; 981 unless ($database_table_exists ) { # exists means the table can be described; 982 my $schema_obj = $db->{$table}; 983 if ($schema_obj->can("create_table")) { 984 #warn "creating table $database_table_name with object $schema_obj"; 985 $schema_obj->create_table; 986 $str .= "Table '$table' created as '$database_table_name' in database.".CGI::br(); 987 } else { 988 # warn "Skipping creation of '$table' table: no create_table method\n"; 989 } 990 991 } 992 993 } 994 995 # unlock database 996 $str; 997 998 999 } 1000 1001 1002 1003 ################################################################################ 1004 # utilities 1005 ################################################################################ 1006 1007 =head1 UTILITIES 1008 1009 These functions are used by this class's public functions and should not be 1010 called directly. 1011 1012 =over 1013 1014 =item callHelperIfExists($helperName, $dbLayoutName, @args) 1015 1016 Call a database-specific helper function, if a database-layout specific helper 1017 class exists and contains a function named "${helperName}Helper". 1018 1019 =cut 1020 1021 sub callHelperIfExists { 1022 my ($helperName, $dbLayoutName, @args) = @_; 1023 1024 my $helperRef = getHelperRef($helperName, $dbLayoutName); 1025 if (ref $helperRef) { 1026 return $helperRef->(@args); 1027 } else { 1028 return $helperRef; 1029 } 1030 } 1031 1032 =over 1033 1034 =item getHelperRef($helperName, $dbLayoutName) 1035 1036 Call a database-specific helper function, if a database-layout specific helper 1037 class exists and contains a function named "${helperName}Helper". 1038 1039 =cut 1040 sub getHelperRef { 1041 my ($helperName, $dbLayoutName) = @_; 1042 1043 my $result; 1044 1045 my $package = __PACKAGE__ . "::$dbLayoutName"; 1046 1047 eval { runtime_use $package }; 1048 if ($@) { 1049 if ($@ =~ /^Can't locate/) { 1050 debug("No database-layout specific library for layout '$dbLayoutName'.\n"); 1051 $result = 1; 1052 } else { 1053 warn "Failed to load database-layout specific library: $@\n"; 1054 $result = 0; 1055 } 1056 } else { 1057 my %syms = do { no strict 'refs'; %{$package."::"} }; 1058 if (exists $syms{$helperName}) { 1059 $result = do { no strict 'refs'; \&{$package."::".$helperName} }; 1060 } else { 1061 debug("No helper defined for operation '$helperName'.\n"); 1062 $result = 1; 1063 } 1064 } 1065 1066 #warn "getHelperRef = '$result'\n"; 1067 return $result; 1068 } 1069 1070 =item protectQString($string) 1071 1072 Protects the contents of a single-quoted Perl string. 1073 1074 =cut 1075 1076 sub protectQString { 1077 my ($string) = @_; 1078 $string =~ s/'/\'/g; 1079 return $string; 1080 } 1081 1082 =item writeCourseConf($fh, $ce, %options) 1083 1084 Writes a course.conf file to $fh, a file handle, using defaults from the course 1085 environment object $ce and overrides from %options. %options can contain any of 1086 the pairs accepted in %courseOptions by addCourse(), above. 1087 1088 =cut 1089 1090 sub writeCourseConf { 1091 my ($fh, $ce, %options) = @_; 1092 1093 # several options should be defined no matter what 1094 $options{dbLayoutName} = $ce->{dbLayoutName} unless defined $options{dbLayoutName}; 1095 1096 print $fh <<'EOF'; 1097 #!perl 1098 ################################################################################ 1099 # WeBWorK Online Homework Delivery System 1100 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 1101 # 1102 # This program is free software; you can redistribute it and/or modify it under 1103 # the terms of either: (a) the GNU General Public License as published by the 1104 # Free Software Foundation; either version 2, or (at your option) any later 1105 # version, or (b) the "Artistic License" which comes with this package. 1106 # 1107 # This program is distributed in the hope that it will be useful, but WITHOUT 1108 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 1109 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 1110 # Artistic License for more details. 1111 ################################################################################ 1112 1113 # This file is used to override the global WeBWorK course environment for 1114 # requests to this course. All package variables set in this file are added to 1115 # the course environment. If you wish to set a variable here but omit it from 1116 # the course environment, use the "my" keyword. Commonly changed configuration 1117 # options are noted below. 1118 1119 EOF 1120 1121 print $fh <<'EOF'; 1122 # Database Layout (global value typically defined in global.conf) 1123 # 1124 # Several database are defined in the file conf/database.conf and stored in the 1125 # hash %dbLayouts. 1126 # 1127 # The database layout is always set here, since one should be able to change the 1128 # default value in global.conf without disrupting existing courses. 1129 # 1130 # global.conf values: 1131 EOF 1132 1133 print $fh "# \t", '$dbLayoutName = \'', protectQString($ce->{dbLayoutName}), '\';', "\n"; 1134 print $fh "# \t", '*dbLayout = $dbLayouts{$dbLayoutName};', "\n"; 1135 print $fh "\n"; 1136 1137 if (defined $options{dbLayoutName}) { 1138 print $fh '$dbLayoutName = \'', protectQString($options{dbLayoutName}), '\';', "\n"; 1139 print $fh '*dbLayout = $dbLayouts{$dbLayoutName};', "\n"; 1140 print $fh "\n"; 1141 } else { 1142 print $fh "\n\n\n"; 1143 } 1144 1145 print $fh <<'EOF'; 1146 # Allowed Mail Recipients (global value typically not defined) 1147 # 1148 # Defines addresses to which the PG system is allowed to send mail. This should 1149 # probably be set to the addresses of professors of this course. Sending mail 1150 # from the PG system (i.e. questionaires, essay questions) will fail if this is 1151 # not set. 1152 # 1153 # global.conf values: 1154 EOF 1155 1156 if (defined $ce->{mail}->{allowedRecipients}) { 1157 print $fh "# \t", '$mail{allowedRecipients} = [', 1158 join(", ", map { "'" . protectQString($_) . "'" } @{ $ce->{mail}->{allowedRecipients} }), '];', "\n"; 1159 } else { 1160 print $fh "# \t", '$mail{allowedRecipients} = [ ];', "\n"; 1161 } 1162 print $fh "\n"; 1163 1164 if (defined $options{allowedRecipients}) { 1165 print $fh '$mail{allowedRecipients} = [', 1166 join(", ", map { "'" . protectQString($_) . "'" } @{ $options{allowedRecipients} }), '];', "\n"; 1167 print $fh "\n"; 1168 } else { 1169 print $fh "\n\n\n"; 1170 } 1171 1172 print $fh <<'EOF'; 1173 # By default, feeback is sent to all users who have permission to 1174 # receive_feedback. If this list is non-empty, feedback is also sent to the 1175 # addresses specified here. 1176 # 1177 # * If you want to disable feedback altogether, leave this empty and set 1178 # $permissionLevels{submit_feeback} = undef; 1179 # This will cause the 1180 # feedback button to go away as well. 1181 # 1182 # * If you want to send email ONLY to addresses in this list, set 1183 # $permissionLevels{receive_feedback} = undef; 1184 # 1185 # It's often useful to set this in the course.conf to change the behavior of 1186 # feedback for a specific course. 1187 # global.conf values: 1188 EOF 1189 1190 if (defined $ce->{mail}->{feedbackRecipients}) { 1191 print $fh "# \t", '$mail{feedbackRecipients} = [', 1192 join(", ", map { "'" . protectQString($_) . "'" } @{ $ce->{mail}->{feedbackRecipients} }), '];', "\n"; 1193 } else { 1194 print $fh "# \t", '$mail{feedbackRecipients} = [ ];', "\n"; 1195 } 1196 print $fh "\n"; 1197 1198 if (defined $options{feedbackRecipients}) { 1199 print $fh '$mail{feedbackRecipients} = [', 1200 join(", ", map { "'" . protectQString($_) . "'" } @{ $options{feedbackRecipients} }), '];', "\n"; 1201 print $fh "\n"; 1202 } else { 1203 print $fh "\n\n\n"; 1204 } 1205 1206 print $fh <<'EOF'; 1207 # Users for whom to label problems with the PG file name (global value typically "professor") 1208 # 1209 # For users in this list, PG will display the source file name when rendering a problem. 1210 # 1211 # global.conf values: 1212 EOF 1213 1214 if (defined $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR}) { 1215 print $fh "# \t", '$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} = [', 1216 join(", ", map { "'" . protectQString($_) . "'" } @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }), '];', "\n"; 1217 } else { 1218 print $fh "# \t", '$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} = [ ];', "\n"; 1219 } 1220 print $fh "\n"; 1221 1222 if (defined $options{PRINT_FILE_NAMES_FOR}) { 1223 print $fh '$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} = [', 1224 join(", ", map { "'" . protectQString($_) . "'" } @{ $options{PRINT_FILE_NAMES_FOR} }), '];', "\n"; 1225 print $fh "\n"; 1226 } else { 1227 print $fh "\n\n\n"; 1228 } 1229 } 1230 1231 1232 sub get_SeedCE { # helper subroutine to produce a stripped down seed Course Environment from an arbitrary course environment 1233 my $ce = shift; 1234 warn "get_SeedCE needs current Course environment to create seed CE" unless ref($ce) ; 1235 my %seedCE=(); 1236 my @conf_items = qw( webwork_dir webwork_url pg_dir courseName) ; # items to transfer. courseName is often overridden 1237 foreach my $item (@conf_items) { 1238 $seedCE{$item} = $ce->{$item}; 1239 } 1240 return( %seedCE); 1241 } 1242 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |