Parent Directory
| 
Revision Log
allow for courses with no contact people in the admin course when deleting or archiving courses.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.53 2006/07/24 23:28:41 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::ContentGenerator::CourseAdmin; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI qw(-nosticky ); 29 use WeBWorK::CGI; 30 use Data::Dumper; 31 use File::Temp qw/tempfile/; 32 use WeBWorK::CourseEnvironment; 33 use IO::File; 34 use WeBWorK::Debug; 35 use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive); 36 use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse 37 listArchivedCourses unarchiveCourse); 38 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 39 40 sub pre_header_initialize { 41 my ($self) = @_; 42 my $r = $self->r; 43 my $ce = $r->ce; 44 my $db = $r->db; 45 my $authz = $r->authz; 46 my $urlpath = $r->urlpath; 47 my $user = $r->param('user'); 48 49 # check permissions 50 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 51 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 52 return; 53 } 54 55 # get result and send to message 56 my $status_message = $r->param("status_message"); 57 $self->addmessage(CGI::p("$status_message")) if $status_message; 58 59 ## if the user is asking for the downloaded database... 60 #if (defined $r->param("download_exported_database")) { 61 # my $courseID = $r->param("export_courseID"); 62 # my $random_chars = $r->param("download_exported_database"); 63 # 64 # die "courseID not specified" unless defined $courseID; 65 # die "invalid file specification" unless $random_chars =~ m/^\w+$/; 66 # 67 # my $tempdir = $ce->{webworkDirs}->{tmp}; 68 # my $export_file = "$tempdir/db_export_$random_chars"; 69 # 70 # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0); 71 # 72 # return ""; 73 #} 74 # 75 ## otherwise... 76 77 my @errors; 78 my $method_to_call; 79 80 my $subDisplay = $r->param("subDisplay"); 81 if (defined $subDisplay) { 82 83 if ($subDisplay eq "add_course") { 84 if (defined $r->param("add_course")) { 85 @errors = $self->add_course_validate; 86 if (@errors) { 87 $method_to_call = "add_course_form"; 88 } else { 89 $method_to_call = "do_add_course"; 90 } 91 } else { 92 $method_to_call = "add_course_form"; 93 } 94 } 95 96 elsif ($subDisplay eq "rename_course") { 97 if (defined $r->param("rename_course")) { 98 @errors = $self->rename_course_validate; 99 if (@errors) { 100 $method_to_call = "rename_course_form"; 101 } else { 102 $method_to_call = "do_rename_course"; 103 } 104 } else { 105 $method_to_call = "rename_course_form"; 106 } 107 } 108 109 elsif ($subDisplay eq "delete_course") { 110 if (defined $r->param("delete_course")) { 111 # validate or confirm 112 @errors = $self->delete_course_validate; 113 if (@errors) { 114 $method_to_call = "delete_course_form"; 115 } else { 116 $method_to_call = "delete_course_confirm"; 117 } 118 } elsif (defined $r->param("confirm_delete_course")) { 119 # validate and delete 120 @errors = $self->delete_course_validate; 121 if (@errors) { 122 $method_to_call = "delete_course_form"; 123 } else { 124 $method_to_call = "do_delete_course"; 125 } 126 } else { 127 # form only 128 $method_to_call = "delete_course_form"; 129 } 130 } 131 132 elsif ($subDisplay eq "export_database") { 133 if (defined $r->param("export_database")) { 134 @errors = $self->export_database_validate; 135 if (@errors) { 136 $method_to_call = "export_database_form"; 137 } else { 138 # we have to do something special here, since we're sending 139 # the database as we export it. $method_to_call still gets 140 # set here, but it gets caught by header() and content() 141 # below instead of by body(). 142 $method_to_call = "do_export_database"; 143 } 144 } else { 145 $method_to_call = "export_database_form"; 146 } 147 } 148 149 elsif ($subDisplay eq "import_database") { 150 if (defined $r->param("import_database")) { 151 @errors = $self->import_database_validate; 152 if (@errors) { 153 $method_to_call = "import_database_form"; 154 } else { 155 $method_to_call = "do_import_database"; 156 } 157 } else { 158 $method_to_call = "import_database_form"; 159 } 160 } 161 162 elsif ($subDisplay eq "archive_course") { 163 if (defined $r->param("archive_course")) { 164 # validate or confirm 165 @errors = $self->archive_course_validate; 166 if (@errors) { 167 $method_to_call = "archive_course_form"; 168 } else { 169 $method_to_call = "archive_course_confirm"; 170 } 171 } elsif (defined $r->param("confirm_archive_course")) { 172 # validate and archive 173 @errors = $self->archive_course_validate; 174 if (@errors) { 175 $method_to_call = "archive_course_form"; 176 } else { 177 $method_to_call = "do_archive_course"; 178 } 179 } else { 180 # form only 181 $method_to_call = "archive_course_form"; 182 } 183 } 184 elsif ($subDisplay eq "unarchive_course") { 185 if (defined $r->param("unarchive_course")) { 186 # validate or confirm 187 @errors = $self->unarchive_course_validate; 188 if (@errors) { 189 $method_to_call = "unarchive_course_form"; 190 } else { 191 $method_to_call = "unarchive_course_confirm"; 192 } 193 } elsif (defined $r->param("confirm_unarchive_course")) { 194 # validate and archive 195 @errors = $self->unarchive_course_validate; 196 if (@errors) { 197 $method_to_call = "unarchive_course_form"; 198 } else { 199 $method_to_call = "do_unarchive_course"; 200 } 201 } else { 202 # form only 203 $method_to_call = "unarchive_course_form"; 204 } 205 } 206 else { 207 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 208 } 209 210 } 211 212 $self->{errors} = \@errors; 213 $self->{method_to_call} = $method_to_call; 214 } 215 216 sub header { 217 my ($self) = @_; 218 my $method_to_call = $self->{method_to_call}; 219 # if (defined $method_to_call and $method_to_call eq "do_export_database") { 220 # my $r = $self->r; 221 # my $courseID = $r->param("export_courseID"); 222 # $r->content_type("application/octet-stream"); 223 # $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 224 # $r->send_http_header; 225 # } else { 226 $self->SUPER::header; 227 # } 228 } 229 230 # sends: 231 # 232 # HTTP/1.1 200 OK 233 # Date: Fri, 09 Jul 2004 19:05:55 GMT 234 # Server: Apache/1.3.27 (Unix) mod_perl/1.27 235 # Content-Disposition: attachment; filename="mth143_database.xml" 236 # Connection: close 237 # Content-Type: application/octet-stream 238 239 sub content { 240 my ($self) = @_; 241 my $method_to_call = $self->{method_to_call}; 242 if (defined $method_to_call and $method_to_call eq "do_export_database") { 243 #$self->do_export_database; 244 $self->SUPER::content; 245 } else { 246 $self->SUPER::content; 247 } 248 } 249 250 sub body { 251 my ($self) = @_; 252 my $r = $self->r; 253 my $ce = $r->ce; 254 my $db = $r->db; 255 my $authz = $r->authz; 256 my $urlpath = $r->urlpath; 257 258 my $user = $r->param('user'); 259 260 # check permissions 261 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 262 return ""; 263 } 264 my $method_to_call = $self->{method_to_call}; 265 my $methodMessage =""; 266 267 (defined($method_to_call) and $method_to_call eq "do_export_database") && do { 268 my @export_courseID = $r->param("export_courseID"); 269 my $course_ids = join(", ", @export_courseID); 270 $methodMessage = CGI::p("Exporting database for course(s) $course_ids"). 271 CGI::p(".... please wait.... 272 If your browser times out you will 273 still be able to download the exported database using the 274 file manager.").CGI::hr(); 275 }; 276 277 278 print CGI::p({style=>"text-align: center"}, 279 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1, 280 add_dbLayout=>'sql_single', 281 add_templates_course => $ce->{siteDefaults}->{default_templates_course} ||""} 282 )}, 283 "Add Course" 284 ), 285 " | ", 286 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"), 287 " | ", 288 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 289 " | ", 290 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 291 " | ", 292 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 293 " | ", 294 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"), 295 "|", 296 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"), 297 CGI::hr(), 298 $methodMessage, 299 300 ); 301 302 print CGI::p("The ability to import and to export databases is still under development. 303 It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to 304 use webwork2/bin/wwdb or the mysql dump facility for archiving large courses. 305 Please send bug reports if you find errors. "); 306 307 my @errors = @{$self->{errors}}; 308 309 310 if (@errors) { 311 print CGI::div({class=>"ResultsWithError"}, 312 CGI::p("Please correct the following errors and try again:"), 313 CGI::ul(CGI::li(\@errors)), 314 ); 315 } 316 317 if (defined $method_to_call and $method_to_call ne "") { 318 $self->$method_to_call; 319 } else { 320 321 print CGI::h2("Courses"); 322 323 print CGI::start_ol(); 324 325 my @courseIDs = listCourses($ce); 326 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 327 next if $courseID eq "admin"; # done already above 328 my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID); 329 my $tempCE = WeBWorK::CourseEnvironment->new( 330 $ce->{webworkDirs}->{root}, 331 $ce->{webworkURLs}->{root}, 332 $ce->{pg}->{directories}->{root}, 333 $courseID, 334 ); 335 print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID), 336 CGI::code( 337 $tempCE->{dbLayoutName}, 338 ), 339 (-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"), 340 341 ); 342 343 } 344 345 print CGI::end_ol(); 346 347 print CGI::h2("Archived Courses"); 348 print CGI::start_ol(); 349 350 @courseIDs = listArchivedCourses($ce); 351 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 352 print CGI::li($courseID), 353 } 354 355 print CGI::end_ol(); 356 } 357 return ""; 358 } 359 360 ################################################################################ 361 362 sub add_course_form { 363 my ($self) = @_; 364 my $r = $self->r; 365 my $ce = $r->ce; 366 #my $db = $r->db; 367 #my $authz = $r->authz; 368 #my $urlpath = $r->urlpath; 369 370 my $add_courseID = $r->param("add_courseID") || ""; 371 my $add_courseTitle = $r->param("add_courseTitle") || ""; 372 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 373 374 my $add_admin_users = $r->param("add_admin_users") || ""; 375 376 my $add_initial_userID = $r->param("add_initial_userID") || ""; 377 my $add_initial_password = $r->param("add_initial_password") || ""; 378 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 379 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 380 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 381 my $add_initial_email = $r->param("add_initial_email") || ""; 382 383 my $add_templates_course = $r->param("add_templates_course") || ""; 384 385 my $add_dbLayout = $r->param("add_dbLayout") || ""; 386 my $add_sql_host = $r->param("add_sql_host") || ""; 387 my $add_sql_port = $r->param("add_sql_port") || ""; 388 my $add_sql_username = $r->param("add_sql_username") || ""; 389 my $add_sql_password = $r->param("add_sql_password") || ""; 390 my $add_sql_database = $r->param("add_sql_database") || ""; 391 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 392 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 393 394 my @dbLayouts = do { 395 my @ordered_layouts; 396 foreach my $layout (@{$ce->{dbLayout_order}}) { 397 if (exists $ce->{dbLayouts}->{$layout}) { 398 push @ordered_layouts, $layout; 399 } 400 } 401 402 my %ordered_layouts; @ordered_layouts{@ordered_layouts} = (); 403 my @other_layouts; 404 foreach my $layout (keys %{ $ce->{dbLayouts} }) { 405 unless (exists $ordered_layouts{$layout}) { 406 push @other_layouts, $layout; 407 } 408 } 409 410 (@ordered_layouts, @other_layouts); 411 }; 412 413 my $ce2 = WeBWorK::CourseEnvironment->new( 414 $ce->{webworkDirs}->{root}, 415 $ce->{webworkURLs}->{root}, 416 $ce->{pg}->{directories}->{root}, 417 "COURSENAME", 418 ); 419 420 my @existingCourses = listCourses($ce); 421 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive 422 423 print CGI::h2("Add Course"); 424 425 print CGI::start_form(-method=>"POST", -action=>$r->uri); 426 print $self->hidden_authen_fields; 427 print $self->hidden_fields("subDisplay"); 428 429 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 430 431 print CGI::table({class=>"FormLayout"}, 432 CGI::Tr({}, 433 CGI::th({class=>"LeftHeader"}, "Course ID:"), 434 CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)), 435 ), 436 CGI::Tr({}, 437 CGI::th({class=>"LeftHeader"}, "Course Title:"), 438 CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)), 439 ), 440 CGI::Tr({}, 441 CGI::th({class=>"LeftHeader"}, "Institution:"), 442 CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)), 443 ), 444 ); 445 446 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 447 my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked. 448 print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course")); 449 450 print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only 451 numbers, letters, hyphens, periods (dots), commas,and underscores.\n"); 452 453 print CGI::table({class=>"FormLayout"}, CGI::Tr({}, 454 CGI::td({}, 455 CGI::table({class=>"FormLayout"}, 456 CGI::Tr({}, 457 CGI::th({class=>"LeftHeader"}, "User ID:"), 458 CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)), 459 ), 460 CGI::Tr({}, 461 CGI::th({class=>"LeftHeader"}, "Password:"), 462 CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)), 463 ), 464 CGI::Tr({}, 465 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 466 CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)), 467 ), 468 ), 469 ), 470 CGI::td({}, 471 CGI::table({class=>"FormLayout"}, 472 CGI::Tr({}, 473 CGI::th({class=>"LeftHeader"}, "First Name:"), 474 CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)), 475 ), 476 CGI::Tr({}, 477 CGI::th({class=>"LeftHeader"}, "Last Name:"), 478 CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)), 479 ), 480 CGI::Tr({}, 481 CGI::th({class=>"LeftHeader"}, "Email Address:"), 482 CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)), 483 ), 484 ), 485 486 ), 487 )); 488 489 print CGI::p("To copy problem templates from an existing course, select the course below."); 490 491 print CGI::table({class=>"FormLayout"}, 492 CGI::Tr({}, 493 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 494 CGI::td( 495 CGI::popup_menu( 496 -name => "add_templates_course", 497 -values => [ "", @existingCourses ], 498 -default => $add_templates_course, 499 #-size => 10, 500 #-multiple => 0, 501 #-labels => \%courseLabels, 502 ), 503 504 ), 505 ), 506 ); 507 508 print CGI::p("Select a database layout below."); 509 print CGI::start_table({class=>"FormLayout"}); 510 foreach my $dbLayout (@dbLayouts) { 511 512 513 my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout}) 514 ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout} 515 : "$dbLayout - no description provided in global.conf"; 516 517 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 518 print CGI::Tr({}, 519 CGI::td({width=>'20%'}, 520 # why did this not work? because values aren't escaped? 521 # '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 522 # . ($add_dbLayout eq $dbLayout ? 'checked=>"1"' : '') . ' />', 523 CGI::radio_group(-name =>"add_dbLayout", 524 -value => [$dbLayout], 525 -default => $dbLayout, 526 ), 527 528 ), 529 CGI::td($dbLayoutLabel), 530 ); 531 532 533 } 534 print CGI::end_table(); 535 print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course")); 536 537 print CGI::end_form(); 538 } 539 540 sub add_course_validate { 541 my ($self) = @_; 542 my $r = $self->r; 543 my $ce = $r->ce; 544 #my $db = $r->db; 545 #my $authz = $r->authz; 546 #my $urlpath = $r->urlpath; 547 548 my $add_courseID = $r->param("add_courseID") || ""; 549 my $add_courseTitle = $r->param("add_courseTitle") || ""; 550 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 551 552 my $add_admin_users = $r->param("add_admin_users") || ""; 553 554 my $add_initial_userID = $r->param("add_initial_userID") || ""; 555 my $add_initial_password = $r->param("add_initial_password") || ""; 556 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 557 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 558 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 559 my $add_initial_email = $r->param("add_initial_email") || ""; 560 561 my $add_templates_course = $r->param("add_templates_course") || ""; 562 563 my $add_dbLayout = $r->param("add_dbLayout") || ""; 564 my $add_sql_host = $r->param("add_sql_host") || ""; 565 my $add_sql_port = $r->param("add_sql_port") || ""; 566 my $add_sql_username = $r->param("add_sql_username") || ""; 567 my $add_sql_password = $r->param("add_sql_password") || ""; 568 my $add_sql_database = $r->param("add_sql_database") || ""; 569 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 570 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 571 572 my @errors; 573 574 if ($add_courseID eq "") { 575 push @errors, "You must specify a course ID."; 576 } 577 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 578 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 579 } 580 if (grep { $add_courseID eq $_ } listCourses($ce)) { 581 push @errors, "A course with ID $add_courseID already exists."; 582 } 583 if ($add_courseTitle eq "") { 584 push @errors, "You must specify a course title."; 585 } 586 if ($add_courseInstitution eq "") { 587 push @errors, "You must specify an institution for this course."; 588 } 589 590 if ($add_initial_userID ne "") { 591 if ($add_initial_password eq "") { 592 push @errors, "You must specify a password for the initial instructor."; 593 } 594 if ($add_initial_confirmPassword eq "") { 595 push @errors, "You must confirm the password for the initial instructor."; 596 } 597 if ($add_initial_password ne $add_initial_confirmPassword) { 598 push @errors, "The password and password confirmation for the instructor must match."; 599 } 600 if ($add_initial_firstName eq "") { 601 push @errors, "You must specify a first name for the initial instructor."; 602 } 603 if ($add_initial_lastName eq "") { 604 push @errors, "You must specify a last name for the initial instructor."; 605 } 606 if ($add_initial_email eq "") { 607 push @errors, "You must specify an email address for the initial instructor."; 608 } 609 } 610 611 if ($add_dbLayout eq "") { 612 push @errors, "You must select a database layout."; 613 } else { 614 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 615 if ($add_dbLayout eq "sql") { 616 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 617 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 618 } elsif ($add_dbLayout eq "gdbm") { 619 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 620 } 621 } else { 622 push @errors, "The database layout $add_dbLayout doesn't exist."; 623 } 624 } 625 626 return @errors; 627 } 628 629 sub do_add_course { 630 my ($self) = @_; 631 my $r = $self->r; 632 my $ce = $r->ce; 633 my $db = $r->db; 634 my $authz = $r->authz; 635 my $urlpath = $r->urlpath; 636 637 my $add_courseID = $r->param("add_courseID") || ""; 638 my $add_courseTitle = $r->param("add_courseTitle") || ""; 639 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 640 641 my $add_admin_users = $r->param("add_admin_users") || ""; 642 643 my $add_initial_userID = $r->param("add_initial_userID") || ""; 644 my $add_initial_password = $r->param("add_initial_password") || ""; 645 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 646 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 647 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 648 my $add_initial_email = $r->param("add_initial_email") || ""; 649 650 my $add_templates_course = $r->param("add_templates_course") || ""; 651 652 my $add_dbLayout = $r->param("add_dbLayout") || ""; 653 my $add_sql_host = $r->param("add_sql_host") || ""; 654 my $add_sql_port = $r->param("add_sql_port") || ""; 655 my $add_sql_username = $r->param("add_sql_username") || ""; 656 my $add_sql_password = $r->param("add_sql_password") || ""; 657 my $add_sql_database = $r->param("add_sql_database") || ""; 658 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 659 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 660 661 my $ce2 = WeBWorK::CourseEnvironment->new( 662 $ce->{webworkDirs}->{root}, 663 $ce->{webworkURLs}->{root}, 664 $ce->{pg}->{directories}->{root}, 665 $add_courseID, 666 ); 667 668 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 669 670 if ($add_initial_email ne "") { 671 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 672 # don't set feedbackRecipients -- this just gets in the way of the more 673 # intelligent "receive_recipients" method. 674 #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; 675 } 676 677 if ($add_dbLayout eq "gdbm") { 678 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 679 } 680 681 my %dbOptions; 682 if ($add_dbLayout eq "sql") { 683 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 684 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 685 $dbOptions{username} = $add_sql_username; 686 $dbOptions{password} = $add_sql_password; 687 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID"; 688 $dbOptions{wwhost} = $add_sql_wwhost; 689 } 690 691 my @users; 692 693 # copy users from current (admin) course if desired 694 if ($add_admin_users ne "") { 695 foreach my $userID ($db->listUsers) { 696 if ($userID eq $add_initial_userID) { 697 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor."); 698 next; 699 } 700 my $User = $db->getUser($userID); 701 my $Password = $db->getPassword($userID); 702 my $PermissionLevel = $db->getPermissionLevel($userID); 703 push @users, [ $User, $Password, $PermissionLevel ] 704 if $authz->hasPermissions($userID,"create_and_delete_courses"); 705 #only transfer the "instructors" in the admin course classlist. 706 } 707 } 708 709 # add initial instructor if desired 710 if ($add_initial_userID ne "") { 711 my $User = $db->newUser( 712 user_id => $add_initial_userID, 713 first_name => $add_initial_firstName, 714 last_name => $add_initial_lastName, 715 student_id => $add_initial_userID, 716 email_address => $add_initial_email, 717 status => "C", 718 ); 719 my $Password = $db->newPassword( 720 user_id => $add_initial_userID, 721 password => cryptPassword($add_initial_password), 722 ); 723 my $PermissionLevel = $db->newPermissionLevel( 724 user_id => $add_initial_userID, 725 permission => "10", 726 ); 727 push @users, [ $User, $Password, $PermissionLevel ]; 728 } 729 730 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users; 731 732 my %optional_arguments; 733 if ($add_templates_course ne "") { 734 $optional_arguments{templatesFrom} = $add_templates_course; 735 } 736 737 eval { 738 addCourse( 739 courseID => $add_courseID, 740 ce => $ce2, 741 courseOptions => \%courseOptions, 742 dbOptions => \%dbOptions, 743 users => \@users, 744 %optional_arguments, 745 ); 746 }; 747 if ($@) { 748 my $error = $@; 749 print CGI::div({class=>"ResultsWithError"}, 750 CGI::p("An error occured while creating the course $add_courseID:"), 751 CGI::tt(CGI::escapeHTML($error)), 752 ); 753 # get rid of any partially built courses 754 # FIXME -- this is too fragile 755 unless ($error =~ /course exists/) { 756 eval { 757 deleteCourse( 758 courseID => $add_courseID, 759 ce => $ce2, 760 dbOptions => \%dbOptions, 761 ); 762 } 763 } 764 } else { 765 #log the action 766 writeLog($ce, "hosted_courses", join("\t", 767 "\tAdded", 768 $add_courseInstitution, 769 $add_courseTitle, 770 $add_courseID, 771 $add_initial_firstName, 772 $add_initial_lastName, 773 $add_initial_email, 774 )); 775 # add contact to admin course as student? 776 # FIXME -- should we do this? 777 if ($add_initial_userID ne "") { 778 my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact 779 my $User = $db->newUser( 780 user_id => $composite_id, # student id includes school name and contact 781 first_name => $add_initial_firstName, 782 last_name => $add_initial_lastName, 783 student_id => $add_initial_userID, 784 email_address => $add_initial_email, 785 status => "C", 786 ); 787 my $Password = $db->newPassword( 788 user_id => $composite_id, 789 password => cryptPassword($add_initial_password), 790 ); 791 my $PermissionLevel = $db->newPermissionLevel( 792 user_id => $composite_id, 793 permission => "0", 794 ); 795 # add contact to admin course as student 796 # or if this contact and course already exist in a dropped status 797 # change the student's status to enrolled 798 if (my $oldUser = $db->getUser($composite_id) ) { 799 warn "Replacing old data for $composite_id status: ". $oldUser->status; 800 $db->deleteUser($composite_id); 801 } 802 eval { $db->addUser($User) }; warn $@ if $@; 803 eval { $db->addPassword($Password) }; warn $@ if $@; 804 eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; 805 } 806 print CGI::div({class=>"ResultsWithoutError"}, 807 CGI::p("Successfully created the course $add_courseID"), 808 ); 809 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 810 courseID => $add_courseID); 811 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 812 print CGI::div({style=>"text-align: center"}, 813 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 814 ); 815 } 816 817 818 } 819 820 ################################################################################ 821 822 sub rename_course_form { 823 my ($self) = @_; 824 my $r = $self->r; 825 my $ce = $r->ce; 826 #my $db = $r->db; 827 #my $authz = $r->authz; 828 #my $urlpath = $r->urlpath; 829 830 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 831 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 832 833 my $rename_sql_host = $r->param("rename_sql_host") || ""; 834 my $rename_sql_port = $r->param("rename_sql_port") || ""; 835 my $rename_sql_username = $r->param("rename_sql_username") || ""; 836 my $rename_sql_password = $r->param("rename_sql_password") || ""; 837 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 838 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 839 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 840 841 my @courseIDs = listCourses($ce); 842 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; 843 844 my %courseLabels; # records... heh. 845 foreach my $courseID (@courseIDs) { 846 my $tempCE = WeBWorK::CourseEnvironment->new( 847 $ce->{webworkDirs}->{root}, 848 $ce->{webworkURLs}->{root}, 849 $ce->{pg}->{directories}->{root}, 850 $courseID, 851 ); 852 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 853 } 854 855 print CGI::h2("Rename Course"); 856 857 print CGI::start_form(-method=>"POST", -action=>$r->uri); 858 print $self->hidden_authen_fields; 859 print $self->hidden_fields("subDisplay"); 860 861 print CGI::p("Select a course to rename."); 862 863 print CGI::table({class=>"FormLayout"}, 864 CGI::Tr({}, 865 CGI::th({class=>"LeftHeader"}, "Course Name:"), 866 CGI::td( 867 CGI::scrolling_list( 868 -name => "rename_oldCourseID", 869 -values => \@courseIDs, 870 -default => $rename_oldCourseID, 871 -size => 10, 872 -multiple => 0, 873 -labels => \%courseLabels, 874 ), 875 ), 876 ), 877 CGI::Tr({}, 878 CGI::th({class=>"LeftHeader"}, "New Name:"), 879 CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)), 880 ), 881 ); 882 883 # print CGI::p( 884 # "If the course's database layout (indicated in parentheses above) is " 885 # . CGI::b("sql") . ", supply the SQL connections information requested below." 886 # ); 887 # 888 # print CGI::start_table({class=>"FormLayout"}); 889 # print CGI::Tr(CGI::td({colspan=>2}, 890 # "Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases." 891 # ) 892 # ); 893 # print CGI::Tr({}, 894 # CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 895 # CGI::td(CGI::textfield(-name=>"rename_sql_username", -value=>$rename_sql_username, -size=>25)), 896 # ); 897 # print CGI::Tr({}, 898 # CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 899 # CGI::td(CGI::password_field(-name=>"rename_sql_password", -value=>$rename_sql_password, -size=>25)), 900 # ); 901 # 902 # print CGI::Tr({}, 903 # CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 904 # CGI::td({}, 905 # CGI::textfield(-name=>"rename_sql_host", -value=>$rename_sql_host, -size=>25), 906 # CGI::br(), 907 # CGI::small("Leave blank to use the default host."), 908 # ), 909 # ); 910 # print CGI::Tr({}, 911 # CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 912 # CGI::td({}, 913 # CGI::textfield(-name=>"rename_sql_port", -value=>$rename_sql_port, -size=>25), 914 # CGI::br(), 915 # CGI::small("Leave blank to use the default port."), 916 # ), 917 # ); 918 # 919 # print CGI::Tr({}, 920 # CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"), 921 # CGI::td({}, 922 # CGI::textfield(-name=>"rename_sql_database", -value=>$rename_sql_oldDatabase, -size=>25), 923 # CGI::br(), 924 # CGI::small("Leave blank to use the name ". CGI::tt("webwork_COURSENAME"). "."), 925 # ), 926 # ); 927 # print CGI::Tr({}, 928 # CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"), 929 # CGI::td({}, 930 # CGI::textfield(-name=>"rename_sql_database", -value=>$rename_sql_newDatabase, -size=>25), 931 # CGI::br(), 932 # CGI::small("Leave blank to use the name ".CGI::tt("webwork_COURSENAME"). "."), 933 # ), 934 # ); 935 # print CGI::Tr({}, 936 # CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 937 # CGI::td({}, 938 # CGI::textfield(-name=>"rename_sql_wwhost", -value=>$rename_sql_wwhost || "localhost", -size=>25), 939 # CGI::br(), 940 # 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."), 941 # ), 942 # ); 943 print CGI::end_table(); 944 945 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course")); 946 947 print CGI::end_form(); 948 } 949 950 sub rename_course_validate { 951 my ($self) = @_; 952 my $r = $self->r; 953 my $ce = $r->ce; 954 #my $db = $r->db; 955 #my $authz = $r->authz; 956 #my $urlpath = $r->urlpath; 957 958 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 959 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 960 961 my $rename_sql_host = $r->param("rename_sql_host") || ""; 962 my $rename_sql_port = $r->param("rename_sql_port") || ""; 963 my $rename_sql_username = $r->param("rename_sql_username") || ""; 964 my $rename_sql_password = $r->param("rename_sql_password") || ""; 965 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 966 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 967 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 968 969 my @errors; 970 971 if ($rename_oldCourseID eq "") { 972 push @errors, "You must select a course to rename."; 973 } 974 if ($rename_newCourseID eq "") { 975 push @errors, "You must specify a new name for the course."; 976 } 977 if ($rename_oldCourseID eq $rename_newCourseID) { 978 push @errors, "Can't rename to the same name."; 979 } 980 unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 981 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 982 } 983 if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { 984 push @errors, "A course with ID $rename_newCourseID already exists."; 985 } 986 987 my $ce2 = WeBWorK::CourseEnvironment->new( 988 $ce->{webworkDirs}->{root}, 989 $ce->{webworkURLs}->{root}, 990 $ce->{pg}->{directories}->{root}, 991 $rename_oldCourseID, 992 ); 993 994 if ($ce2->{dbLayoutName} eq "sql") { 995 push @errors, "You must specify the SQL admin username." if $rename_sql_username eq ""; 996 #push @errors, "You must specify the SQL admin password." if $rename_sql_password eq ""; 997 #push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq ""; 998 #push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq ""; 999 } 1000 1001 return @errors; 1002 } 1003 1004 sub do_rename_course { 1005 my ($self) = @_; 1006 my $r = $self->r; 1007 my $ce = $r->ce; 1008 my $db = $r->db; 1009 #my $authz = $r->authz; 1010 my $urlpath = $r->urlpath; 1011 1012 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 1013 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 1014 1015 my $rename_sql_host = $r->param("rename_sql_host") || ""; 1016 my $rename_sql_port = $r->param("rename_sql_port") || ""; 1017 my $rename_sql_username = $r->param("rename_sql_username") || ""; 1018 my $rename_sql_password = $r->param("rename_sql_password") || ""; 1019 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 1020 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 1021 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 1022 1023 my $ce2 = WeBWorK::CourseEnvironment->new( 1024 $ce->{webworkDirs}->{root}, 1025 $ce->{webworkURLs}->{root}, 1026 $ce->{pg}->{directories}->{root}, 1027 $rename_oldCourseID, 1028 ); 1029 1030 my $dbLayoutName = $ce->{dbLayoutName}; 1031 1032 my %dbOptions; 1033 if ($dbLayoutName eq "sql") { 1034 $dbOptions{host} = $rename_sql_host if $rename_sql_host ne ""; 1035 $dbOptions{port} = $rename_sql_port if $rename_sql_port ne ""; 1036 $dbOptions{username} = $rename_sql_username; 1037 $dbOptions{password} = $rename_sql_password; 1038 $dbOptions{old_database} = $rename_sql_oldDatabase || "webwork_$rename_oldCourseID"; 1039 $dbOptions{new_database} = $rename_sql_newDatabase || "webwork_$rename_newCourseID"; 1040 $dbOptions{wwhost} = $rename_sql_wwhost; 1041 } 1042 1043 eval { 1044 renameCourse( 1045 courseID => $rename_oldCourseID, 1046 ce => $ce2, 1047 dbOptions => \%dbOptions, 1048 newCourseID => $rename_newCourseID, 1049 ); 1050 }; 1051 if ($@) { 1052 my $error = $@; 1053 print CGI::div({class=>"ResultsWithError"}, 1054 CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"), 1055 CGI::tt(CGI::escapeHTML($error)), 1056 ); 1057 } else { 1058 print CGI::div({class=>"ResultsWithoutError"}, 1059 CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"), 1060 ); 1061 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 1062 courseID => $rename_newCourseID); 1063 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 1064 print CGI::div({style=>"text-align: center"}, 1065 CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"), 1066 ); 1067 } 1068 } 1069 1070 ################################################################################ 1071 1072 sub delete_course_form { 1073 my ($self) = @_; 1074 my $r = $self->r; 1075 my $ce = $r->ce; 1076 #my $db = $r->db; 1077 #my $authz = $r->authz; 1078 #my $urlpath = $r->urlpath; 1079 1080 my $delete_courseID = $r->param("delete_courseID") || ""; 1081 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1082 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1083 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1084 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1085 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1086 1087 my @courseIDs = listCourses($ce); 1088 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1089 1090 my %courseLabels; # records... heh. 1091 foreach my $courseID (@courseIDs) { 1092 my $tempCE = WeBWorK::CourseEnvironment->new( 1093 $ce->{webworkDirs}->{root}, 1094 $ce->{webworkURLs}->{root}, 1095 $ce->{pg}->{directories}->{root}, 1096 $courseID, 1097 ); 1098 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1099 } 1100 1101 print CGI::h2("Delete Course"); 1102 1103 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1104 print $self->hidden_authen_fields; 1105 print $self->hidden_fields("subDisplay"); 1106 1107 print CGI::p("Select a course to delete."); 1108 1109 print CGI::table({class=>"FormLayout"}, 1110 CGI::Tr({}, 1111 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1112 CGI::td( 1113 CGI::scrolling_list( 1114 -name => "delete_courseID", 1115 -values => \@courseIDs, 1116 -default => $delete_courseID, 1117 -size => 10, 1118 -multiple => 0, 1119 -labels => \%courseLabels, 1120 ), 1121 ), 1122 ), 1123 ); 1124 1125 print CGI::p( 1126 "If the course's database layout (indicated in parentheses above) is " 1127 . CGI::b("sql") . ", supply the SQL connections information requested below." 1128 ); 1129 1130 print CGI::start_table({class=>"FormLayout"}); 1131 print CGI::Tr(CGI::td({colspan=>2}, 1132 "Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database." 1133 ) 1134 ); 1135 print CGI::Tr({}, 1136 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 1137 CGI::td(CGI::textfield(-name=>"delete_sql_username", -value=>$delete_sql_username, -size=>25)), 1138 ); 1139 print CGI::Tr({}, 1140 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 1141 CGI::td(CGI::password_field(-name=>"delete_sql_password", -value=>$delete_sql_password, -size=>25)), 1142 ); 1143 1144 #print CGI::Tr(CGI::td({colspan=>2}, 1145 # "The optionial SQL settings you enter below must match the settings in the DBI source" 1146 # . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME") 1147 # . " with the course name you entered above." 1148 # ) 1149 #); 1150 print CGI::Tr({}, 1151 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 1152 CGI::td({}, 1153 CGI::textfield(-name=>"delete_sql_host", -value=>$delete_sql_host, -size=>25), 1154 CGI::br(), 1155 CGI::small(-name=>"Leave blank to use the default host."), 1156 ), 1157 ); 1158 print CGI::Tr({}, 1159 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 1160 CGI::td({}, 1161 CGI::textfield(-name=>"delete_sql_port", -value=>$delete_sql_port, -size=>25), 1162 CGI::br(), 1163 CGI::small("Leave blank to use the default port."), 1164 ), 1165 ); 1166 1167 print CGI::Tr({}, 1168 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 1169 CGI::td({}, 1170 CGI::textfield(-name=>"delete_sql_database", -value=>$delete_sql_database, -size=>25), 1171 CGI::br(), 1172 CGI::small("Leave blank to use the name ". CGI::tt("webwork_COURSENAME"). "."), 1173 ), 1174 ); 1175 print CGI::end_table(); 1176 1177 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course")); 1178 1179 print CGI::end_form(); 1180 } 1181 1182 sub delete_course_validate { 1183 my ($self) = @_; 1184 my $r = $self->r; 1185 my $ce = $r->ce; 1186 #my $db = $r->db; 1187 #my $authz = $r->authz; 1188 my $urlpath = $r->urlpath; 1189 1190 my $delete_courseID = $r->param("delete_courseID") || ""; 1191 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1192 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1193 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1194 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1195 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1196 1197 my @errors; 1198 1199 if ($delete_courseID eq "") { 1200 push @errors, "You must specify a course name."; 1201 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 1202 push @errors, "You cannot delete the course you are currently using."; 1203 } 1204 1205 my $ce2 = WeBWorK::CourseEnvironment->new( 1206 $ce->{webworkDirs}->{root}, 1207 $ce->{webworkURLs}->{root}, 1208 $ce->{pg}->{directories}->{root}, 1209 $delete_courseID, 1210 ); 1211 1212 if ($ce2->{dbLayoutName} eq "sql") { 1213 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 1214 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 1215 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 1216 } 1217 1218 return @errors; 1219 } 1220 1221 sub delete_course_confirm { 1222 my ($self) = @_; 1223 my $r = $self->r; 1224 my $ce = $r->ce; 1225 #my $db = $r->db; 1226 #my $authz = $r->authz; 1227 #my $urlpath = $r->urlpath; 1228 1229 print CGI::h2("Delete Course"); 1230 1231 my $delete_courseID = $r->param("delete_courseID") || ""; 1232 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1233 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1234 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1235 1236 my $ce2 = WeBWorK::CourseEnvironment->new( 1237 $ce->{webworkDirs}->{root}, 1238 $ce->{webworkURLs}->{root}, 1239 $ce->{pg}->{directories}->{root}, 1240 $delete_courseID, 1241 ); 1242 1243 if ($ce2->{dbLayoutName} eq "sql") { 1244 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1245 . "? All course files and data and the following database will be destroyed." 1246 . " There is no undo available."); 1247 1248 print CGI::table({class=>"FormLayout"}, 1249 CGI::Tr({}, 1250 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 1251 CGI::td($delete_sql_host || "system default"), 1252 ), 1253 CGI::Tr({}, 1254 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 1255 CGI::td($delete_sql_port || "system default"), 1256 ), 1257 CGI::Tr({}, 1258 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 1259 CGI::td($delete_sql_database || "webwork_$delete_courseID"), 1260 ), 1261 ); 1262 } else { 1263 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1264 . "? All course files and data will be destroyed. There is no undo available."); 1265 } 1266 1267 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1268 print $self->hidden_authen_fields; 1269 print $self->hidden_fields("subDisplay"); 1270 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 1271 1272 print CGI::p({style=>"text-align: center"}, 1273 CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"), 1274 " ", 1275 CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"), 1276 ); 1277 1278 print CGI::end_form(); 1279 } 1280 1281 sub do_delete_course { 1282 my ($self) = @_; 1283 my $r = $self->r; 1284 my $ce = $r->ce; 1285 my $db = $r->db; 1286 #my $authz = $r->authz; 1287 #my $urlpath = $r->urlpath; 1288 1289 my $delete_courseID = $r->param("delete_courseID") || ""; 1290 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1291 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1292 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1293 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1294 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1295 1296 my $ce2 = WeBWorK::CourseEnvironment->new( 1297 $ce->{webworkDirs}->{root}, 1298 $ce->{webworkURLs}->{root}, 1299 $ce->{pg}->{directories}->{root}, 1300 $delete_courseID, 1301 ); 1302 1303 my %dbOptions; 1304 if ($ce2->{dbLayoutName} eq "sql") { 1305 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 1306 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 1307 $dbOptions{username} = $delete_sql_username; 1308 $dbOptions{password} = $delete_sql_password; 1309 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID"; 1310 } 1311 1312 eval { 1313 deleteCourse( 1314 courseID => $delete_courseID, 1315 ce => $ce2, 1316 dbOptions => \%dbOptions, 1317 ); 1318 }; 1319 1320 if ($@) { 1321 my $error = $@; 1322 print CGI::div({class=>"ResultsWithError"}, 1323 CGI::p("An error occured while deleting the course $delete_courseID:"), 1324 CGI::tt(CGI::escapeHTML($error)), 1325 ); 1326 } else { 1327 # mark the contact person in the admin course as dropped. 1328 # find the contact person for the course by searching the admin classlist. 1329 my @contacts = grep /_$delete_courseID$/, $db->listUsers; 1330 if (@contacts) { 1331 die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1; 1332 #warn "contacts", join(" ", @contacts); 1333 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1334 my $composite_id = $contacts[0]; 1335 1336 # mark the contact person as dropped. 1337 my $User = $db->getUser($composite_id); 1338 my $status_name = 'Drop'; 1339 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 1340 $User->status($status_value); 1341 $db->putUser($User); 1342 } 1343 1344 print CGI::div({class=>"ResultsWithoutError"}, 1345 CGI::p("Successfully deleted the course $delete_courseID."), 1346 ); 1347 writeLog($ce, "hosted_courses", join("\t", 1348 "\tDeleted", 1349 "", 1350 "", 1351 $delete_courseID, 1352 )); 1353 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1354 print $self->hidden_authen_fields; 1355 print $self->hidden_fields("subDisplay"); 1356 1357 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),); 1358 1359 print CGI::end_form(); 1360 } 1361 } 1362 1363 ################################################################################ 1364 1365 sub export_database_form { 1366 my ($self) = @_; 1367 my $r = $self->r; 1368 my $ce = $r->ce; 1369 #my $db = $r->db; 1370 #my $authz = $r->authz; 1371 #my $urlpath = $r->urlpath; 1372 1373 my @tables = keys %{$ce->{dbLayout}}; 1374 1375 my $export_courseID = $r->param("export_courseID") || ""; 1376 my @export_tables = $r->param("export_tables"); 1377 1378 @export_tables = @tables unless @export_tables; 1379 1380 my @courseIDs = listCourses($ce); 1381 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1382 1383 my %courseLabels; # records... heh. 1384 foreach my $courseID (@courseIDs) { 1385 my $tempCE = WeBWorK::CourseEnvironment->new( 1386 $ce->{webworkDirs}->{root}, 1387 $ce->{webworkURLs}->{root}, 1388 $ce->{pg}->{directories}->{root}, 1389 $courseID, 1390 ); 1391 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1392 } 1393 1394 print CGI::h2("Export Database"); 1395 1396 print CGI::start_form(-method=>"GET", -action=>$r->uri); 1397 print $self->hidden_authen_fields; 1398 print $self->hidden_fields("subDisplay"); 1399 1400 print CGI::p({},"Select a course to export the course's database. Please note 1401 that exporting can take a very long time for a large course. If you have 1402 shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), " 1403 utility instead."); 1404 1405 print CGI::table({class=>"FormLayout"}, 1406 CGI::Tr({}, 1407 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1408 CGI::td( 1409 CGI::scrolling_list( 1410 -name => "export_courseID", 1411 -values => \@courseIDs, 1412 -default => $export_courseID, 1413 -size => 10, 1414 -multiple => 1, 1415 -labels => \%courseLabels, 1416 ), 1417 ), 1418 ), 1419 CGI::Tr({}, 1420 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1421 CGI::td({}, 1422 CGI::checkbox_group( 1423 -name => "export_tables", 1424 -values => \@tables, 1425 -default => \@export_tables, 1426 -linebreak => 1, 1427 ), 1428 ), 1429 ), 1430 ); 1431 1432 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database")); 1433 1434 print CGI::end_form(); 1435 } 1436 1437 sub export_database_validate { 1438 my ($self) = @_; 1439 my $r = $self->r; 1440 #my $ce = $r->ce; 1441 #my $db = $r->db; 1442 #my $authz = $r->authz; 1443 #my $urlpath = $r->urlpath; 1444 1445 my @export_courseID = $r->param("export_courseID") || (); 1446 my @export_tables = $r->param("export_tables"); 1447 1448 my @errors; 1449 1450 unless ( @export_courseID) { 1451 push @errors, "You must specify at least one course name."; 1452 } 1453 1454 unless (@export_tables) { 1455 push @errors, "You must specify at least one table to export."; 1456 } 1457 1458 return @errors; 1459 } 1460 1461 sub do_export_database { 1462 my ($self) = @_; 1463 my $r = $self->r; 1464 my $ce = $r->ce; 1465 #my $db = $r->db; 1466 #my $authz = $r->authz; 1467 my $urlpath = $r->urlpath; 1468 1469 my @export_courseID = $r->param("export_courseID"); 1470 my @export_tables = $r->param("export_tables"); 1471 1472 foreach my $export_courseID (@export_courseID) { 1473 1474 my $ce2 = WeBWorK::CourseEnvironment->new( 1475 $ce->{webworkDirs}->{root}, 1476 $ce->{webworkURLs}->{root}, 1477 $ce->{pg}->{directories}->{root}, 1478 $export_courseID, 1479 ); 1480 1481 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1482 1483 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1484 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1485 # export to the admin/templates directory 1486 my $exportFileName = "$export_courseID.exported.xml"; 1487 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName"; 1488 # get a unique name 1489 my $number =1; 1490 while (-e "$exportFilePath.$number.gz") { 1491 $number++; 1492 last if $number>9; 1493 } 1494 if ($number<=9 ) { 1495 $exportFilePath = "$exportFilePath.$number"; 1496 $exportFileName = "$exportFileName.$number"; 1497 } else { 1498 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please 1499 remove some of these files.")); 1500 $exportFilePath = "$exportFilePath.999"; 1501 $exportFileName = "$exportFileName.999"; 1502 } 1503 1504 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath"; 1505 1506 my @errors; 1507 eval { 1508 @errors = dbExport( 1509 db => $db2, 1510 #xml => $fh, 1511 xml => $outputFileHandle, 1512 tables => \@export_tables, 1513 ); 1514 }; 1515 1516 $outputFileHandle->close(); 1517 1518 my $gzipMessage = system( 'gzip', $exportFilePath); 1519 if ( !$gzipMessage ) { 1520 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip. 1521 You may download it with the file manager.")); 1522 } else { 1523 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath")); 1524 } 1525 unlink $exportFilePath; 1526 } # end export of one course 1527 #push @errors, "Fatal exception: $@" if $@; 1528 # 1529 #if (@errors) { 1530 # print CGI::div({class=>"ResultsWithError"}, 1531 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1532 # CGI::ul(CGI::li(\@errors)), 1533 # ); 1534 #} else { 1535 # print CGI::div({class=>"ResultsWithoutError"}, 1536 # CGI::p("Export succeeded."), 1537 # ); 1538 # 1539 # print CGI::div({style=>"text-align: center"}, 1540 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1541 # ); 1542 #} 1543 } 1544 1545 ################################################################################ 1546 1547 sub import_database_form { 1548 my ($self) = @_; 1549 my $r = $self->r; 1550 my $ce = $r->ce; 1551 #my $db = $r->db; 1552 #my $authz = $r->authz; 1553 #my $urlpath = $r->urlpath; 1554 1555 my @tables = keys %{$ce->{dbLayout}}; 1556 1557 my $import_file = $r->param("import_file") || ""; 1558 my $import_courseID = $r->param("import_courseID") || ""; 1559 my @import_tables = $r->param("import_tables"); 1560 my $import_conflict = $r->param("import_conflict") || "skip"; 1561 1562 @import_tables = @tables unless @import_tables; 1563 1564 my @courseIDs = listCourses($ce); 1565 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1566 1567 1568 my %courseLabels; # records... heh. 1569 foreach my $courseID (@courseIDs) { 1570 my $tempCE = WeBWorK::CourseEnvironment->new( 1571 $ce->{webworkDirs}->{root}, 1572 $ce->{webworkURLs}->{root}, 1573 $ce->{pg}->{directories}->{root}, 1574 $courseID, 1575 ); 1576 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1577 } 1578 1579 # find databases: 1580 my $templatesDir = $ce->{courseDirs}->{templates}; 1581 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} }; 1582 my $exempt_dirs = join("|", keys %probLibs); 1583 1584 my @databaseFiles = listFilesRecursive( 1585 $templatesDir, 1586 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!! 1587 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories 1588 0, # match against file name only 1589 1, # prune against path relative to $templatesDir 1590 ); 1591 1592 my %databaseLabels = map { ($_ => $_) } @databaseFiles; 1593 1594 ####### 1595 1596 print CGI::h2("Import Database"); 1597 1598 print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART); 1599 print $self->hidden_authen_fields; 1600 print $self->hidden_fields("subDisplay"); 1601 1602 print CGI::table({class=>"FormLayout"}, 1603 CGI::Tr({}, 1604 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1605 CGI::td( 1606 CGI::scrolling_list( 1607 -name => "import_file", 1608 -values => \@databaseFiles, 1609 -default => undef, 1610 -size => 10, 1611 -multiple => 0, 1612 -labels => \%databaseLabels, 1613 ), 1614 1615 ) 1616 ), 1617 CGI::Tr({}, 1618 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1619 CGI::td( 1620 CGI::checkbox_group( 1621 -name => "import_tables", 1622 -values => \@tables, 1623 -default => \@import_tables, 1624 -linebreak => 1, 1625 ), 1626 ), 1627 ), 1628 CGI::Tr({}, 1629 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1630 CGI::td( 1631 CGI::scrolling_list( 1632 -name => "import_courseID", 1633 -values => \@courseIDs, 1634 -default => $import_courseID, 1635 -size => 10, 1636 -multiple => 0, 1637 -labels => \%courseLabels, 1638 ), 1639 ), 1640 ), 1641 CGI::Tr({}, 1642 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1643 CGI::td( 1644 CGI::radio_group( 1645 -name => "import_conflict", 1646 -values => [qw/skip replace/], 1647 -default => $import_conflict, 1648 -linebreak=>'true', 1649 -labels => { 1650 skip => "Skip duplicate records", 1651 replace => "Replace duplicate records", 1652 }, 1653 ), 1654 ), 1655 ), 1656 ); 1657 1658 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database")); 1659 1660 print CGI::end_form(); 1661 } 1662 1663 sub import_database_validate { 1664 my ($self) = @_; 1665 my $r = $self->r; 1666 #my $ce = $r->ce; 1667 #my $db = $r->db; 1668 #my $authz = $r->authz; 1669 #my $urlpath = $r->urlpath; 1670 1671 my $import_file = $r->param("import_file") || ""; 1672 my $import_courseID = $r->param("import_courseID") || ""; 1673 my @import_tables = $r->param("import_tables"); 1674 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1675 1676 my @errors; 1677 1678 if ($import_file eq "") { 1679 push @errors, "You must specify a database file to import."; 1680 } 1681 1682 if ($import_courseID eq "") { 1683 push @errors, "You must specify a course name."; 1684 } 1685 1686 unless (@import_tables) { 1687 push @errors, "You must specify at least one table to import."; 1688 } 1689 1690 return @errors; 1691 } 1692 1693 sub do_import_database { 1694 my ($self) = @_; 1695 my $r = $self->r; 1696 my $ce = $r->ce; 1697 #my $db = $r->db; 1698 #my $authz = $r->authz; 1699 my $urlpath = $r->urlpath; 1700 1701 my $import_file = $r->param("import_file"); 1702 my $import_courseID = $r->param("import_courseID"); 1703 my @import_tables = $r->param("import_tables"); 1704 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1705 1706 my $ce2 = WeBWorK::CourseEnvironment->new( 1707 $ce->{webworkDirs}->{root}, 1708 $ce->{webworkURLs}->{root}, 1709 $ce->{pg}->{directories}->{root}, 1710 $import_courseID, 1711 ); 1712 1713 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1714 1715 # locate file 1716 my $templateDir = $ce->{courseDirs}->{templates}; 1717 my $filePath = "$templateDir/$import_file"; 1718 1719 my $gunzipMessage = system( 'gunzip', $filePath); 1720 #FIXME 1721 #warn "gunzip ", $gunzipMessage; 1722 $filePath =~ s/\.gz$//; 1723 #warn "new file path is $filePath"; 1724 my $fileHandle = new IO::File("<$filePath"); 1725 # retrieve upload from upload cache 1726 # my ($id, $hash) = split /\s+/, $import_file; 1727 # my $upload = WeBWorK::Upload->retrieve($id, $hash, 1728 # dir => $ce->{webworkDirs}->{uploadCache} 1729 # ); 1730 1731 my @errors; 1732 1733 eval { 1734 @errors = dbImport( 1735 db => $db2, 1736 # xml => $upload->fileHandle, 1737 xml => $fileHandle, 1738 tables => \@import_tables, 1739 conflict => $import_conflict, 1740 ); 1741 }; 1742 1743 push @errors, "Fatal exception: $@" if $@; 1744 push @errors, $gunzipMessage if $gunzipMessage; 1745 1746 if (@errors) { 1747 print CGI::div({class=>"ResultsWithError"}, 1748 CGI::p("An error occured while importing the database of course $import_courseID:"), 1749 CGI::ul(CGI::li(\@errors)), 1750 ); 1751 } else { 1752 print CGI::div({class=>"ResultsWithoutError"}, 1753 CGI::p("Import succeeded."), 1754 ); 1755 } 1756 } 1757 ########################################################################## 1758 sub archive_course_form { 1759 my ($self) = @_; 1760 my $r = $self->r; 1761 my $ce = $r->ce; 1762 #my $db = $r->db; 1763 #my $authz = $r->authz; 1764 #my $urlpath = $r->urlpath; 1765 1766 my $archive_courseID = $r->param("archive_courseID") || ""; 1767 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1768 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1769 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1770 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1771 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1772 1773 my @courseIDs = listCourses($ce); 1774 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1775 1776 my %courseLabels; # records... heh. 1777 foreach my $courseID (@courseIDs) { 1778 my $tempCE = WeBWorK::CourseEnvironment->new( 1779 $ce->{webworkDirs}->{root}, 1780 $ce->{webworkURLs}->{root}, 1781 $ce->{pg}->{directories}->{root}, 1782 $courseID, 1783 ); 1784 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1785 } 1786 1787 print CGI::h2("archive Course"); 1788 1789 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1790 print $self->hidden_authen_fields; 1791 print $self->hidden_fields("subDisplay"); 1792 1793 print CGI::p("Select a course to archive."); 1794 1795 print CGI::table({class=>"FormLayout"}, 1796 CGI::Tr({}, 1797 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1798 CGI::td( 1799 CGI::scrolling_list( 1800 -name => "archive_courseID", 1801 -values => \@courseIDs, 1802 -default => $archive_courseID, 1803 -size => 10, 1804 -multiple => 0, 1805 -labels => \%courseLabels, 1806 ), 1807 ), 1808 1809 ), 1810 CGI::Tr({}, 1811 CGI::th({class=>"LeftHeader"}, "Delete course:"), 1812 CGI::td({-style=>'color:red'}, CGI::checkbox({ 1813 -name=>'delete_course', 1814 -checked=>0, 1815 -value => 1, 1816 -label =>'Delete course after archiving. Caution there is no undo!', 1817 }, 1818 ), 1819 ), 1820 ) 1821 ); 1822 1823 print CGI::p( 1824 "Currently the archive facility is only available for mysql databases. 1825 It depends on the mysqldump application." 1826 ); 1827 1828 1829 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course", -value=>"archive Course")); 1830 1831 print CGI::end_form(); 1832 } 1833 1834 sub archive_course_validate { 1835 my ($self) = @_; 1836 my $r = $self->r; 1837 my $ce = $r->ce; 1838 #my $db = $r->db; 1839 #my $authz = $r->authz; 1840 my $urlpath = $r->urlpath; 1841 1842 my $archive_courseID = $r->param("archive_courseID") || ""; 1843 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1844 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1845 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1846 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1847 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1848 1849 my @errors; 1850 1851 if ($archive_courseID eq "") { 1852 push @errors, "You must specify a course name."; 1853 } elsif ($archive_courseID eq $urlpath->arg("courseID")) { 1854 push @errors, "You cannot archive the course you are currently using."; 1855 } 1856 1857 my $ce2 = WeBWorK::CourseEnvironment->new( 1858 $ce->{webworkDirs}->{root}, 1859 $ce->{webworkURLs}->{root}, 1860 $ce->{pg}->{directories}->{root}, 1861 $archive_courseID, 1862 ); 1863 1864 if ($ce2->{dbLayoutName} eq "sql") { 1865 push @errors, "You must specify the SQL admin username." if $archive_sql_username eq ""; 1866 #push @errors, "You must specify the SQL admin password." if $archive_sql_password eq ""; 1867 #push @errors, "You must specify the SQL database name." if $archive_sql_database eq ""; 1868 } 1869 1870 return @errors; 1871 } 1872 1873 sub archive_course_confirm { 1874 my ($self) = @_; 1875 my $r = $self->r; 1876 my $ce = $r->ce; 1877 #my $db = $r->db; 1878 #my $authz = $r->authz; 1879 #my $urlpath = $r->urlpath; 1880 1881 print CGI::h2("archive Course"); 1882 1883 my $archive_courseID = $r->param("archive_courseID") || ""; 1884 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1885 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1886 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1887 my $delete_course_flag = $r->param("delete_course") || ""; 1888 my $ce2 = WeBWorK::CourseEnvironment->new( 1889 $ce->{webworkDirs}->{root}, 1890 $ce->{webworkURLs}->{root}, 1891 $ce->{pg}->{directories}->{root}, 1892 $archive_courseID, 1893 ); 1894 1895 if ($ce2->{dbLayoutName} ) { 1896 print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID) 1897 . "? "); 1898 print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ". 1899 CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag; 1900 1901 1902 } 1903 1904 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1905 print $self->hidden_authen_fields; 1906 print $self->hidden_fields("subDisplay"); 1907 print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database delete_course/); 1908 1909 print CGI::p({style=>"text-align: center"}, 1910 CGI::submit(-name=>"decline_archive_course", -value=>"Don't archive"), 1911 " ", 1912 CGI::submit(-name=>"confirm_archive_course", -value=>"archive"), 1913 ); 1914 1915 print CGI::end_form(); 1916 } 1917 1918 sub do_archive_course { 1919 my ($self) = @_; 1920 my $r = $self->r; 1921 my $ce = $r->ce; 1922 my $db = $r->db; 1923 #my $authz = $r->authz; 1924 #my $urlpath = $r->urlpath; 1925 1926 my $archive_courseID = $r->param("archive_courseID") || ""; 1927 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1928 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1929 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1930 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1931 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1932 my $delete_course_flag = $r->param("delete_course") || ""; 1933 1934 my $ce2 = WeBWorK::CourseEnvironment->new( 1935 $ce->{webworkDirs}->{root}, 1936 $ce->{webworkURLs}->{root}, 1937 $ce->{pg}->{directories}->{root}, 1938 $archive_courseID, 1939 ); 1940 1941 my %dbOptions; 1942 if ($ce2->{dbLayoutName} eq "sql") { 1943 $dbOptions{host} = $archive_sql_host if $archive_sql_host ne ""; 1944 $dbOptions{port} = $archive_sql_port if $archive_sql_port ne ""; 1945 $dbOptions{username} = $archive_sql_username; 1946 $dbOptions{password} = $archive_sql_password; 1947 $dbOptions{database} = $archive_sql_database || "webwork_$archive_courseID"; 1948 } 1949 1950 eval { 1951 archiveCourse( 1952 courseID => $archive_courseID, 1953 ce => $ce2, 1954 dbOptions => \%dbOptions, 1955 ); 1956 }; 1957 1958 if ($@) { 1959 my $error = $@; 1960 print CGI::div({class=>"ResultsWithError"}, 1961 CGI::p("An error occured while archiving the course $archive_courseID:"), 1962 CGI::tt(CGI::escapeHTML($error)), 1963 ); 1964 } else { 1965 print CGI::div({class=>"ResultsWithoutError"}, 1966 CGI::p("Successfully archived the course $archive_courseID"), 1967 ); 1968 writeLog($ce, "hosted_courses", join("\t", 1969 "\tarchived", 1970 "", 1971 "", 1972 $archive_courseID, 1973 )); 1974 1975 if ($delete_course_flag) { 1976 eval { 1977 deleteCourse( 1978 courseID => $archive_courseID, 1979 ce => $ce2, 1980 dbOptions => \%dbOptions, 1981 ); 1982 }; 1983 1984 if ($@) { 1985 my $error = $@; 1986 print CGI::div({class=>"ResultsWithError"}, 1987 CGI::p("An error occured while deleting the course $archive_courseID:"), 1988 CGI::tt(CGI::escapeHTML($error)), 1989 ); 1990 } else { 1991 # mark the contact person in the admin course as dropped. 1992 # find the contact person for the course by searching the admin classlist. 1993 my @contacts = grep /_$archive_courseID$/, $db->listUsers; 1994 if (@contacts) { 1995 die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1; 1996 #warn "contacts", join(" ", @contacts); 1997 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1998 my $composite_id = $contacts[0]; 1999 2000 # mark the contact person as dropped. 2001 my $User = $db->getUser($composite_id); 2002 my $status_name = 'Drop'; 2003 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 2004 $User->status($status_value); 2005 $db->putUser($User); 2006 } 2007 2008 print CGI::div({class=>"ResultsWithoutError"}, 2009 CGI::p("Successfully deleted the course $archive_courseID."), 2010 ); 2011 } 2012 2013 2014 } 2015 2016 # print CGI::start_form(-method=>"POST", -action=>$r->uri); 2017 # print $self->hidden_authen_fields; 2018 # print $self->hidden_fields("subDisplay"); 2019 # 2020 # print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),); 2021 # 2022 # print CGI::end_form(); 2023 } 2024 } 2025 ########################################################################## 2026 sub unarchive_course_form { 2027 my ($self) = @_; 2028 my $r = $self->r; 2029 my $ce = $r->ce; 2030 #my $db = $r->db; 2031 #my $authz = $r->authz; 2032 #my $urlpath = $r->urlpath; 2033 2034 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2035 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2036 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2037 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2038 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2039 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2040 2041 # First find courses which have been archived. 2042 my @courseIDs = listArchivedCourses($ce); 2043 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 2044 2045 my %courseLabels; # records... heh. 2046 foreach my $courseID (@courseIDs) { 2047 $courseLabels{$courseID} = $courseID; 2048 } 2049 2050 print CGI::h2("Unarchive Course -- not yet operational"); 2051 2052 print CGI::start_form(-method=>"POST", -action=>$r->uri); 2053 print $self->hidden_authen_fields; 2054 print $self->hidden_fields("subDisplay"); 2055 2056 print CGI::p("Select a course to unarchive."); 2057 2058 print CGI::table({class=>"FormLayout"}, 2059 CGI::Tr({}, 2060 CGI::th({class=>"LeftHeader"}, "Course Name:"), 2061 CGI::td( 2062 CGI::scrolling_list( 2063 -name => "unarchive_courseID", 2064 -values => \@courseIDs, 2065 -default => $unarchive_courseID, 2066 -size => 10, 2067 -multiple => 0, 2068 -labels => \%courseLabels, 2069 ), 2070 ), 2071 ), 2072 ); 2073 2074 print CGI::p( 2075 "Currently the unarchive facility is only available for mysql databases. 2076 It depends on the mysqldump application." 2077 ); 2078 2079 2080 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course")); 2081 2082 print CGI::end_form(); 2083 } 2084 2085 sub unarchive_course_validate { 2086 my ($self) = @_; 2087 my $r = $self->r; 2088 my $ce = $r->ce; 2089 #my $db = $r->db; 2090 #my $authz = $r->authz; 2091 my $urlpath = $r->urlpath; 2092 2093 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2094 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2095 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2096 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2097 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2098 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2099 2100 my @errors; 2101 2102 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 2103 2104 if ($new_courseID eq "") { 2105 push @errors, "You must specify a course name."; 2106 } elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) { 2107 #Check that a directory for this course doesn't already exist 2108 push @errors, "A directory already exists with the name $new_courseID. 2109 You must first delete this existing course before you can unarchive."; 2110 } 2111 2112 2113 2114 return @errors; 2115 } 2116 2117 sub unarchive_course_confirm { 2118 my ($self) = @_; 2119 my $r = $self->r; 2120 my $ce = $r->ce; 2121 #my $db = $r->db; 2122 #my $authz = $r->authz; 2123 #my $urlpath = $r->urlpath; 2124 2125 print CGI::h2("Unarchive Course"); 2126 2127 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2128 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2129 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2130 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2131 2132 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 2133 2134 2135 2136 print CGI::start_form(-method=>"POST", -action=>$r->uri); 2137 print CGI::p($unarchive_courseID," to course ", 2138 CGI::input({-name=>'new_courseID', -value=>$new_courseID}) 2139 ); 2140 2141 print $self->hidden_authen_fields; 2142 print $self->hidden_fields("subDisplay"); 2143 print $self->hidden_fields(qw/unarchive_courseID 2144 unarchive_sql_host 2145 unarchive_sql_port 2146 unarchive_sql_username 2147 unarchive_sql_password 2148 unarchive_sql_database/); 2149 2150 print CGI::p({style=>"text-align: center"}, 2151 CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"), 2152 " ", 2153 CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"), 2154 ); 2155 2156 print CGI::end_form(); 2157 } 2158 2159 sub do_unarchive_course { 2160 my ($self) = @_; 2161 my $r = $self->r; 2162 my $ce = $r->ce; 2163 #my $db = $r->db; 2164 #my $authz = $r->authz; 2165 my $urlpath = $r->urlpath; 2166 my $new_courseID = $r->param("new_courseID") || ""; 2167 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2168 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2169 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2170 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2171 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2172 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2173 2174 2175 my %dbOptions; 2176 2177 eval { 2178 unarchiveCourse( 2179 courseID => $new_courseID, 2180 archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID", 2181 ce => $ce , # $ce2, 2182 dbOptions => undef, 2183 ); 2184 }; 2185 2186 if ($@) { 2187 my $error = $@; 2188 print CGI::div({class=>"ResultsWithError"}, 2189 CGI::p("An error occured while archiving the course $unarchive_courseID:"), 2190 CGI::tt(CGI::escapeHTML($error)), 2191 ); 2192 } else { 2193 print CGI::div({class=>"ResultsWithoutError"}, 2194 CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"), 2195 ); 2196 writeLog($ce, "hosted_courses", join("\t", 2197 "\tunarchived", 2198 "", 2199 "", 2200 "$unarchive_courseID to $new_courseID", 2201 )); 2202 2203 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 2204 courseID => $new_courseID); 2205 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 2206 print CGI::div({style=>"text-align: center"}, 2207 CGI::a({href=>$newCourseURL}, "Log into $new_courseID"), 2208 ); 2209 } 2210 } 2211 2212 ################################################################################ 2213 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |