Parent Directory
| 
Revision Log
Converting from use CGI to use WeBWorK::CGI The only substantial change is in Hardcopy where set_id was changed to "sid" I believe that change is correct.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.48 2006/07/08 14:07:34 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("POST", $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("add_courseID", $add_courseID, 25)), 435 ), 436 CGI::Tr( 437 CGI::th({class=>"LeftHeader"}, "Course Title:"), 438 CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)), 439 ), 440 CGI::Tr( 441 CGI::th({class=>"LeftHeader"}, "Institution:"), 442 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 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": ""; # 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("add_initial_userID", $add_initial_userID, 25)), 459 ), 460 CGI::Tr( 461 CGI::th({class=>"LeftHeader"}, "Password:"), 462 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 463 ), 464 CGI::Tr( 465 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 466 CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 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("add_initial_firstName", $add_initial_firstName, 25)), 475 ), 476 CGI::Tr( 477 CGI::th({class=>"LeftHeader"}, "Last Name:"), 478 CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)), 479 ), 480 CGI::Tr( 481 CGI::th({class=>"LeftHeader"}, "Email Address:"), 482 CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 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 510 foreach my $dbLayout (@dbLayouts) { 511 print CGI::start_table({class=>"FormLayout"}); 512 513 my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout}) 514 ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout} 515 : $dbLayout; 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({style=>"text-align: right"}, 520 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 521 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 522 ), 523 CGI::td($dbLayoutLabel), 524 ); 525 526 print CGI::end_table(); 527 } 528 529 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 530 531 print CGI::end_form(); 532 } 533 534 sub add_course_validate { 535 my ($self) = @_; 536 my $r = $self->r; 537 my $ce = $r->ce; 538 #my $db = $r->db; 539 #my $authz = $r->authz; 540 #my $urlpath = $r->urlpath; 541 542 my $add_courseID = $r->param("add_courseID") || ""; 543 my $add_courseTitle = $r->param("add_courseTitle") || ""; 544 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 545 546 my $add_admin_users = $r->param("add_admin_users") || ""; 547 548 my $add_initial_userID = $r->param("add_initial_userID") || ""; 549 my $add_initial_password = $r->param("add_initial_password") || ""; 550 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 551 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 552 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 553 my $add_initial_email = $r->param("add_initial_email") || ""; 554 555 my $add_templates_course = $r->param("add_templates_course") || ""; 556 557 my $add_dbLayout = $r->param("add_dbLayout") || ""; 558 my $add_sql_host = $r->param("add_sql_host") || ""; 559 my $add_sql_port = $r->param("add_sql_port") || ""; 560 my $add_sql_username = $r->param("add_sql_username") || ""; 561 my $add_sql_password = $r->param("add_sql_password") || ""; 562 my $add_sql_database = $r->param("add_sql_database") || ""; 563 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 564 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 565 566 my @errors; 567 568 if ($add_courseID eq "") { 569 push @errors, "You must specify a course ID."; 570 } 571 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 572 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 573 } 574 if (grep { $add_courseID eq $_ } listCourses($ce)) { 575 push @errors, "A course with ID $add_courseID already exists."; 576 } 577 if ($add_courseTitle eq "") { 578 push @errors, "You must specify a course title."; 579 } 580 if ($add_courseInstitution eq "") { 581 push @errors, "You must specify an institution for this course."; 582 } 583 584 if ($add_initial_userID ne "") { 585 if ($add_initial_password eq "") { 586 push @errors, "You must specify a password for the initial instructor."; 587 } 588 if ($add_initial_confirmPassword eq "") { 589 push @errors, "You must confirm the password for the initial instructor."; 590 } 591 if ($add_initial_password ne $add_initial_confirmPassword) { 592 push @errors, "The password and password confirmation for the instructor must match."; 593 } 594 if ($add_initial_firstName eq "") { 595 push @errors, "You must specify a first name for the initial instructor."; 596 } 597 if ($add_initial_lastName eq "") { 598 push @errors, "You must specify a last name for the initial instructor."; 599 } 600 if ($add_initial_email eq "") { 601 push @errors, "You must specify an email address for the initial instructor."; 602 } 603 } 604 605 if ($add_dbLayout eq "") { 606 push @errors, "You must select a database layout."; 607 } else { 608 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 609 if ($add_dbLayout eq "sql") { 610 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 611 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 612 } elsif ($add_dbLayout eq "gdbm") { 613 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 614 } 615 } else { 616 push @errors, "The database layout $add_dbLayout doesn't exist."; 617 } 618 } 619 620 return @errors; 621 } 622 623 sub do_add_course { 624 my ($self) = @_; 625 my $r = $self->r; 626 my $ce = $r->ce; 627 my $db = $r->db; 628 my $authz = $r->authz; 629 my $urlpath = $r->urlpath; 630 631 my $add_courseID = $r->param("add_courseID") || ""; 632 my $add_courseTitle = $r->param("add_courseTitle") || ""; 633 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 634 635 my $add_admin_users = $r->param("add_admin_users") || ""; 636 637 my $add_initial_userID = $r->param("add_initial_userID") || ""; 638 my $add_initial_password = $r->param("add_initial_password") || ""; 639 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 640 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 641 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 642 my $add_initial_email = $r->param("add_initial_email") || ""; 643 644 my $add_templates_course = $r->param("add_templates_course") || ""; 645 646 my $add_dbLayout = $r->param("add_dbLayout") || ""; 647 my $add_sql_host = $r->param("add_sql_host") || ""; 648 my $add_sql_port = $r->param("add_sql_port") || ""; 649 my $add_sql_username = $r->param("add_sql_username") || ""; 650 my $add_sql_password = $r->param("add_sql_password") || ""; 651 my $add_sql_database = $r->param("add_sql_database") || ""; 652 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 653 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 654 655 my $ce2 = WeBWorK::CourseEnvironment->new( 656 $ce->{webworkDirs}->{root}, 657 $ce->{webworkURLs}->{root}, 658 $ce->{pg}->{directories}->{root}, 659 $add_courseID, 660 ); 661 662 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 663 664 if ($add_initial_email ne "") { 665 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 666 # don't set feedbackRecipients -- this just gets in the way of the more 667 # intelligent "receive_recipients" method. 668 #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; 669 } 670 671 if ($add_dbLayout eq "gdbm") { 672 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 673 } 674 675 my %dbOptions; 676 if ($add_dbLayout eq "sql") { 677 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 678 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 679 $dbOptions{username} = $add_sql_username; 680 $dbOptions{password} = $add_sql_password; 681 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID"; 682 $dbOptions{wwhost} = $add_sql_wwhost; 683 } 684 685 my @users; 686 687 # copy users from current (admin) course if desired 688 if ($add_admin_users ne "") { 689 foreach my $userID ($db->listUsers) { 690 if ($userID eq $add_initial_userID) { 691 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor."); 692 next; 693 } 694 my $User = $db->getUser($userID); 695 my $Password = $db->getPassword($userID); 696 my $PermissionLevel = $db->getPermissionLevel($userID); 697 push @users, [ $User, $Password, $PermissionLevel ] 698 if $authz->hasPermissions($userID,"create_and_delete_courses"); 699 #only transfer the "instructors" in the admin course classlist. 700 } 701 } 702 703 # add initial instructor if desired 704 if ($add_initial_userID ne "") { 705 my $User = $db->newUser( 706 user_id => $add_initial_userID, 707 first_name => $add_initial_firstName, 708 last_name => $add_initial_lastName, 709 student_id => $add_initial_userID, 710 email_address => $add_initial_email, 711 status => "C", 712 ); 713 my $Password = $db->newPassword( 714 user_id => $add_initial_userID, 715 password => cryptPassword($add_initial_password), 716 ); 717 my $PermissionLevel = $db->newPermissionLevel( 718 user_id => $add_initial_userID, 719 permission => "10", 720 ); 721 push @users, [ $User, $Password, $PermissionLevel ]; 722 } 723 724 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users; 725 726 my %optional_arguments; 727 if ($add_templates_course ne "") { 728 $optional_arguments{templatesFrom} = $add_templates_course; 729 } 730 731 eval { 732 addCourse( 733 courseID => $add_courseID, 734 ce => $ce2, 735 courseOptions => \%courseOptions, 736 dbOptions => \%dbOptions, 737 users => \@users, 738 %optional_arguments, 739 ); 740 }; 741 if ($@) { 742 my $error = $@; 743 print CGI::div({class=>"ResultsWithError"}, 744 CGI::p("An error occured while creating the course $add_courseID:"), 745 CGI::tt(CGI::escapeHTML($error)), 746 ); 747 # get rid of any partially built courses 748 # FIXME -- this is too fragile 749 unless ($error =~ /course exists/) { 750 eval { 751 deleteCourse( 752 courseID => $add_courseID, 753 ce => $ce2, 754 dbOptions => \%dbOptions, 755 ); 756 } 757 } 758 } else { 759 #log the action 760 writeLog($ce, "hosted_courses", join("\t", 761 "\tAdded", 762 $add_courseInstitution, 763 $add_courseTitle, 764 $add_courseID, 765 $add_initial_firstName, 766 $add_initial_lastName, 767 $add_initial_email, 768 )); 769 # add contact to admin course as student? 770 # FIXME -- should we do this? 771 if ($add_initial_userID ne "") { 772 my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact 773 my $User = $db->newUser( 774 user_id => $composite_id, # student id includes school name and contact 775 first_name => $add_initial_firstName, 776 last_name => $add_initial_lastName, 777 student_id => $add_initial_userID, 778 email_address => $add_initial_email, 779 status => "C", 780 ); 781 my $Password = $db->newPassword( 782 user_id => $composite_id, 783 password => cryptPassword($add_initial_password), 784 ); 785 my $PermissionLevel = $db->newPermissionLevel( 786 user_id => $composite_id, 787 permission => "0", 788 ); 789 # add contact to admin course as student 790 # or if this contact and course already exist in a dropped status 791 # change the student's status to enrolled 792 if (my $oldUser = $db->getUser($composite_id) ) { 793 warn "Replacing old data for $composite_id status: ". $oldUser->status; 794 $db->deleteUser($composite_id); 795 } 796 eval { $db->addUser($User) }; warn $@ if $@; 797 eval { $db->addPassword($Password) }; warn $@ if $@; 798 eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; 799 } 800 print CGI::div({class=>"ResultsWithoutError"}, 801 CGI::p("Successfully created the course $add_courseID"), 802 ); 803 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 804 courseID => $add_courseID); 805 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 806 print CGI::div({style=>"text-align: center"}, 807 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 808 ); 809 } 810 811 812 } 813 814 ################################################################################ 815 816 sub rename_course_form { 817 my ($self) = @_; 818 my $r = $self->r; 819 my $ce = $r->ce; 820 #my $db = $r->db; 821 #my $authz = $r->authz; 822 #my $urlpath = $r->urlpath; 823 824 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 825 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 826 827 my $rename_sql_host = $r->param("rename_sql_host") || ""; 828 my $rename_sql_port = $r->param("rename_sql_port") || ""; 829 my $rename_sql_username = $r->param("rename_sql_username") || ""; 830 my $rename_sql_password = $r->param("rename_sql_password") || ""; 831 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 832 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 833 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 834 835 my @courseIDs = listCourses($ce); 836 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; 837 838 my %courseLabels; # records... heh. 839 foreach my $courseID (@courseIDs) { 840 my $tempCE = WeBWorK::CourseEnvironment->new( 841 $ce->{webworkDirs}->{root}, 842 $ce->{webworkURLs}->{root}, 843 $ce->{pg}->{directories}->{root}, 844 $courseID, 845 ); 846 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 847 } 848 849 print CGI::h2("Rename Course"); 850 851 print CGI::start_form("POST", $r->uri); 852 print $self->hidden_authen_fields; 853 print $self->hidden_fields("subDisplay"); 854 855 print CGI::p("Select a course to rename."); 856 857 print CGI::table({class=>"FormLayout"}, 858 CGI::Tr( 859 CGI::th({class=>"LeftHeader"}, "Course Name:"), 860 CGI::td( 861 CGI::scrolling_list( 862 -name => "rename_oldCourseID", 863 -values => \@courseIDs, 864 -default => $rename_oldCourseID, 865 -size => 10, 866 -multiple => 0, 867 -labels => \%courseLabels, 868 ), 869 ), 870 ), 871 CGI::Tr( 872 CGI::th({class=>"LeftHeader"}, "New Name:"), 873 CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)), 874 ), 875 ); 876 877 print CGI::p( 878 "If the course's database layout (indicated in parentheses above) is " 879 . CGI::b("sql") . ", supply the SQL connections information requested below." 880 ); 881 882 print CGI::start_table({class=>"FormLayout"}); 883 print CGI::Tr(CGI::td({colspan=>2}, 884 "Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases." 885 ) 886 ); 887 print CGI::Tr( 888 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 889 CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)), 890 ); 891 print CGI::Tr( 892 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 893 CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)), 894 ); 895 896 print CGI::Tr( 897 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 898 CGI::td( 899 CGI::textfield("rename_sql_host", $rename_sql_host, 25), 900 CGI::br(), 901 CGI::small("Leave blank to use the default host."), 902 ), 903 ); 904 print CGI::Tr( 905 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 906 CGI::td( 907 CGI::textfield("rename_sql_port", $rename_sql_port, 25), 908 CGI::br(), 909 CGI::small("Leave blank to use the default port."), 910 ), 911 ); 912 913 print CGI::Tr( 914 CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"), 915 CGI::td( 916 CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25), 917 CGI::br(), 918 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 919 ), 920 ); 921 print CGI::Tr( 922 CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"), 923 CGI::td( 924 CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25), 925 CGI::br(), 926 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 927 ), 928 ); 929 print CGI::Tr( 930 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 931 CGI::td( 932 CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost || "localhost", 25), 933 CGI::br(), 934 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."), 935 ), 936 ); 937 print CGI::end_table(); 938 939 print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course")); 940 941 print CGI::end_form(); 942 } 943 944 sub rename_course_validate { 945 my ($self) = @_; 946 my $r = $self->r; 947 my $ce = $r->ce; 948 #my $db = $r->db; 949 #my $authz = $r->authz; 950 #my $urlpath = $r->urlpath; 951 952 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 953 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 954 955 my $rename_sql_host = $r->param("rename_sql_host") || ""; 956 my $rename_sql_port = $r->param("rename_sql_port") || ""; 957 my $rename_sql_username = $r->param("rename_sql_username") || ""; 958 my $rename_sql_password = $r->param("rename_sql_password") || ""; 959 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 960 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 961 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 962 963 my @errors; 964 965 if ($rename_oldCourseID eq "") { 966 push @errors, "You must select a course to rename."; 967 } 968 if ($rename_newCourseID eq "") { 969 push @errors, "You must specify a new name for the course."; 970 } 971 if ($rename_oldCourseID eq $rename_newCourseID) { 972 push @errors, "Can't rename to the same name."; 973 } 974 unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 975 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 976 } 977 if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { 978 push @errors, "A course with ID $rename_newCourseID already exists."; 979 } 980 981 my $ce2 = WeBWorK::CourseEnvironment->new( 982 $ce->{webworkDirs}->{root}, 983 $ce->{webworkURLs}->{root}, 984 $ce->{pg}->{directories}->{root}, 985 $rename_oldCourseID, 986 ); 987 988 if ($ce2->{dbLayoutName} eq "sql") { 989 push @errors, "You must specify the SQL admin username." if $rename_sql_username eq ""; 990 #push @errors, "You must specify the SQL admin password." if $rename_sql_password eq ""; 991 #push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq ""; 992 #push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq ""; 993 } 994 995 return @errors; 996 } 997 998 sub do_rename_course { 999 my ($self) = @_; 1000 my $r = $self->r; 1001 my $ce = $r->ce; 1002 my $db = $r->db; 1003 #my $authz = $r->authz; 1004 my $urlpath = $r->urlpath; 1005 1006 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 1007 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 1008 1009 my $rename_sql_host = $r->param("rename_sql_host") || ""; 1010 my $rename_sql_port = $r->param("rename_sql_port") || ""; 1011 my $rename_sql_username = $r->param("rename_sql_username") || ""; 1012 my $rename_sql_password = $r->param("rename_sql_password") || ""; 1013 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || ""; 1014 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || ""; 1015 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || ""; 1016 1017 my $ce2 = WeBWorK::CourseEnvironment->new( 1018 $ce->{webworkDirs}->{root}, 1019 $ce->{webworkURLs}->{root}, 1020 $ce->{pg}->{directories}->{root}, 1021 $rename_oldCourseID, 1022 ); 1023 1024 my $dbLayoutName = $ce->{dbLayoutName}; 1025 1026 my %dbOptions; 1027 if ($dbLayoutName eq "sql") { 1028 $dbOptions{host} = $rename_sql_host if $rename_sql_host ne ""; 1029 $dbOptions{port} = $rename_sql_port if $rename_sql_port ne ""; 1030 $dbOptions{username} = $rename_sql_username; 1031 $dbOptions{password} = $rename_sql_password; 1032 $dbOptions{old_database} = $rename_sql_oldDatabase || "webwork_$rename_oldCourseID"; 1033 $dbOptions{new_database} = $rename_sql_newDatabase || "webwork_$rename_newCourseID"; 1034 $dbOptions{wwhost} = $rename_sql_wwhost; 1035 } 1036 1037 eval { 1038 renameCourse( 1039 courseID => $rename_oldCourseID, 1040 ce => $ce2, 1041 dbOptions => \%dbOptions, 1042 newCourseID => $rename_newCourseID, 1043 ); 1044 }; 1045 if ($@) { 1046 my $error = $@; 1047 print CGI::div({class=>"ResultsWithError"}, 1048 CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"), 1049 CGI::tt(CGI::escapeHTML($error)), 1050 ); 1051 } else { 1052 print CGI::div({class=>"ResultsWithoutError"}, 1053 CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"), 1054 ); 1055 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 1056 courseID => $rename_newCourseID); 1057 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 1058 print CGI::div({style=>"text-align: center"}, 1059 CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"), 1060 ); 1061 } 1062 } 1063 1064 ################################################################################ 1065 1066 sub delete_course_form { 1067 my ($self) = @_; 1068 my $r = $self->r; 1069 my $ce = $r->ce; 1070 #my $db = $r->db; 1071 #my $authz = $r->authz; 1072 #my $urlpath = $r->urlpath; 1073 1074 my $delete_courseID = $r->param("delete_courseID") || ""; 1075 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1076 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1077 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1078 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1079 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1080 1081 my @courseIDs = listCourses($ce); 1082 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1083 1084 my %courseLabels; # records... heh. 1085 foreach my $courseID (@courseIDs) { 1086 my $tempCE = WeBWorK::CourseEnvironment->new( 1087 $ce->{webworkDirs}->{root}, 1088 $ce->{webworkURLs}->{root}, 1089 $ce->{pg}->{directories}->{root}, 1090 $courseID, 1091 ); 1092 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1093 } 1094 1095 print CGI::h2("Delete Course"); 1096 1097 print CGI::start_form("POST", $r->uri); 1098 print $self->hidden_authen_fields; 1099 print $self->hidden_fields("subDisplay"); 1100 1101 print CGI::p("Select a course to delete."); 1102 1103 print CGI::table({class=>"FormLayout"}, 1104 CGI::Tr( 1105 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1106 CGI::td( 1107 CGI::scrolling_list( 1108 -name => "delete_courseID", 1109 -values => \@courseIDs, 1110 -default => $delete_courseID, 1111 -size => 10, 1112 -multiple => 0, 1113 -labels => \%courseLabels, 1114 ), 1115 ), 1116 ), 1117 ); 1118 1119 print CGI::p( 1120 "If the course's database layout (indicated in parentheses above) is " 1121 . CGI::b("sql") . ", supply the SQL connections information requested below." 1122 ); 1123 1124 print CGI::start_table({class=>"FormLayout"}); 1125 print CGI::Tr(CGI::td({colspan=>2}, 1126 "Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database." 1127 ) 1128 ); 1129 print CGI::Tr( 1130 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 1131 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 1132 ); 1133 print CGI::Tr( 1134 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 1135 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 1136 ); 1137 1138 #print CGI::Tr(CGI::td({colspan=>2}, 1139 # "The optionial SQL settings you enter below must match the settings in the DBI source" 1140 # . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME") 1141 # . " with the course name you entered above." 1142 # ) 1143 #); 1144 print CGI::Tr( 1145 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 1146 CGI::td( 1147 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 1148 CGI::br(), 1149 CGI::small("Leave blank to use the default host."), 1150 ), 1151 ); 1152 print CGI::Tr( 1153 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 1154 CGI::td( 1155 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 1156 CGI::br(), 1157 CGI::small("Leave blank to use the default port."), 1158 ), 1159 ); 1160 1161 print CGI::Tr( 1162 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 1163 CGI::td( 1164 CGI::textfield("delete_sql_database", $delete_sql_database, 25), 1165 CGI::br(), 1166 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 1167 ), 1168 ); 1169 print CGI::end_table(); 1170 1171 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 1172 1173 print CGI::end_form(); 1174 } 1175 1176 sub delete_course_validate { 1177 my ($self) = @_; 1178 my $r = $self->r; 1179 my $ce = $r->ce; 1180 #my $db = $r->db; 1181 #my $authz = $r->authz; 1182 my $urlpath = $r->urlpath; 1183 1184 my $delete_courseID = $r->param("delete_courseID") || ""; 1185 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1186 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1187 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1188 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1189 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1190 1191 my @errors; 1192 1193 if ($delete_courseID eq "") { 1194 push @errors, "You must specify a course name."; 1195 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 1196 push @errors, "You cannot delete the course you are currently using."; 1197 } 1198 1199 my $ce2 = WeBWorK::CourseEnvironment->new( 1200 $ce->{webworkDirs}->{root}, 1201 $ce->{webworkURLs}->{root}, 1202 $ce->{pg}->{directories}->{root}, 1203 $delete_courseID, 1204 ); 1205 1206 if ($ce2->{dbLayoutName} eq "sql") { 1207 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 1208 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 1209 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 1210 } 1211 1212 return @errors; 1213 } 1214 1215 sub delete_course_confirm { 1216 my ($self) = @_; 1217 my $r = $self->r; 1218 my $ce = $r->ce; 1219 #my $db = $r->db; 1220 #my $authz = $r->authz; 1221 #my $urlpath = $r->urlpath; 1222 1223 print CGI::h2("Delete Course"); 1224 1225 my $delete_courseID = $r->param("delete_courseID") || ""; 1226 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1227 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1228 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1229 1230 my $ce2 = WeBWorK::CourseEnvironment->new( 1231 $ce->{webworkDirs}->{root}, 1232 $ce->{webworkURLs}->{root}, 1233 $ce->{pg}->{directories}->{root}, 1234 $delete_courseID, 1235 ); 1236 1237 if ($ce2->{dbLayoutName} eq "sql") { 1238 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1239 . "? All course files and data and the following database will be destroyed." 1240 . " There is no undo available."); 1241 1242 print CGI::table({class=>"FormLayout"}, 1243 CGI::Tr( 1244 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 1245 CGI::td($delete_sql_host || "system default"), 1246 ), 1247 CGI::Tr( 1248 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 1249 CGI::td($delete_sql_port || "system default"), 1250 ), 1251 CGI::Tr( 1252 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 1253 CGI::td($delete_sql_database || "webwork_$delete_courseID"), 1254 ), 1255 ); 1256 } else { 1257 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1258 . "? All course files and data will be destroyed. There is no undo available."); 1259 } 1260 1261 print CGI::start_form("POST", $r->uri); 1262 print $self->hidden_authen_fields; 1263 print $self->hidden_fields("subDisplay"); 1264 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 1265 1266 print CGI::p({style=>"text-align: center"}, 1267 CGI::submit("decline_delete_course", "Don't delete"), 1268 " ", 1269 CGI::submit("confirm_delete_course", "Delete"), 1270 ); 1271 1272 print CGI::end_form(); 1273 } 1274 1275 sub do_delete_course { 1276 my ($self) = @_; 1277 my $r = $self->r; 1278 my $ce = $r->ce; 1279 my $db = $r->db; 1280 #my $authz = $r->authz; 1281 #my $urlpath = $r->urlpath; 1282 1283 my $delete_courseID = $r->param("delete_courseID") || ""; 1284 my $delete_sql_host = $r->param("delete_sql_host") || ""; 1285 my $delete_sql_port = $r->param("delete_sql_port") || ""; 1286 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1287 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1288 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1289 1290 my $ce2 = WeBWorK::CourseEnvironment->new( 1291 $ce->{webworkDirs}->{root}, 1292 $ce->{webworkURLs}->{root}, 1293 $ce->{pg}->{directories}->{root}, 1294 $delete_courseID, 1295 ); 1296 1297 my %dbOptions; 1298 if ($ce2->{dbLayoutName} eq "sql") { 1299 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 1300 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 1301 $dbOptions{username} = $delete_sql_username; 1302 $dbOptions{password} = $delete_sql_password; 1303 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID"; 1304 } 1305 1306 eval { 1307 deleteCourse( 1308 courseID => $delete_courseID, 1309 ce => $ce2, 1310 dbOptions => \%dbOptions, 1311 ); 1312 }; 1313 1314 if ($@) { 1315 my $error = $@; 1316 print CGI::div({class=>"ResultsWithError"}, 1317 CGI::p("An error occured while deleting the course $delete_courseID:"), 1318 CGI::tt(CGI::escapeHTML($error)), 1319 ); 1320 } else { 1321 # mark the contact person in the admin course as dropped. 1322 # find the contact person for the course by searching the admin classlist. 1323 my @contacts = grep /_$delete_courseID$/, $db->listUsers; 1324 die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1; 1325 #warn "contacts", join(" ", @contacts); 1326 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1327 my $composite_id = $contacts[0]; 1328 1329 # mark the contact person as dropped. 1330 my $User = $db->getUser($composite_id); 1331 my $status_name = 'Drop'; 1332 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 1333 $User->status($status_value); 1334 $db->putUser($User); 1335 1336 print CGI::div({class=>"ResultsWithoutError"}, 1337 CGI::p("Successfully deleted the course $delete_courseID."), 1338 ); 1339 writeLog($ce, "hosted_courses", join("\t", 1340 "\tDeleted", 1341 "", 1342 "", 1343 $delete_courseID, 1344 )); 1345 print CGI::start_form("POST", $r->uri); 1346 print $self->hidden_authen_fields; 1347 print $self->hidden_fields("subDisplay"); 1348 1349 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 1350 1351 print CGI::end_form(); 1352 } 1353 } 1354 1355 ################################################################################ 1356 1357 sub export_database_form { 1358 my ($self) = @_; 1359 my $r = $self->r; 1360 my $ce = $r->ce; 1361 #my $db = $r->db; 1362 #my $authz = $r->authz; 1363 #my $urlpath = $r->urlpath; 1364 1365 my @tables = keys %{$ce->{dbLayout}}; 1366 1367 my $export_courseID = $r->param("export_courseID") || ""; 1368 my @export_tables = $r->param("export_tables"); 1369 1370 @export_tables = @tables unless @export_tables; 1371 1372 my @courseIDs = listCourses($ce); 1373 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1374 1375 my %courseLabels; # records... heh. 1376 foreach my $courseID (@courseIDs) { 1377 my $tempCE = WeBWorK::CourseEnvironment->new( 1378 $ce->{webworkDirs}->{root}, 1379 $ce->{webworkURLs}->{root}, 1380 $ce->{pg}->{directories}->{root}, 1381 $courseID, 1382 ); 1383 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1384 } 1385 1386 print CGI::h2("Export Database"); 1387 1388 print CGI::start_form("GET", $r->uri); 1389 print $self->hidden_authen_fields; 1390 print $self->hidden_fields("subDisplay"); 1391 1392 print CGI::p("Select a course to export the course's database. Please note 1393 that exporting can take a very long time for a large course. If you have 1394 shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), " 1395 utility instead."); 1396 1397 print CGI::table({class=>"FormLayout"}, 1398 CGI::Tr( 1399 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1400 CGI::td( 1401 CGI::scrolling_list( 1402 -name => "export_courseID", 1403 -values => \@courseIDs, 1404 -default => $export_courseID, 1405 -size => 10, 1406 -multiple => 1, 1407 -labels => \%courseLabels, 1408 ), 1409 ), 1410 ), 1411 CGI::Tr( 1412 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1413 CGI::td( 1414 CGI::checkbox_group( 1415 -name => "export_tables", 1416 -values => \@tables, 1417 -default => \@export_tables, 1418 -linebreak => 1, 1419 ), 1420 ), 1421 ), 1422 ); 1423 1424 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 1425 1426 print CGI::end_form(); 1427 } 1428 1429 sub export_database_validate { 1430 my ($self) = @_; 1431 my $r = $self->r; 1432 #my $ce = $r->ce; 1433 #my $db = $r->db; 1434 #my $authz = $r->authz; 1435 #my $urlpath = $r->urlpath; 1436 1437 my @export_courseID = $r->param("export_courseID") || (); 1438 my @export_tables = $r->param("export_tables"); 1439 1440 my @errors; 1441 1442 unless ( @export_courseID) { 1443 push @errors, "You must specify at least one course name."; 1444 } 1445 1446 unless (@export_tables) { 1447 push @errors, "You must specify at least one table to export."; 1448 } 1449 1450 return @errors; 1451 } 1452 1453 sub do_export_database { 1454 my ($self) = @_; 1455 my $r = $self->r; 1456 my $ce = $r->ce; 1457 #my $db = $r->db; 1458 #my $authz = $r->authz; 1459 my $urlpath = $r->urlpath; 1460 1461 my @export_courseID = $r->param("export_courseID"); 1462 my @export_tables = $r->param("export_tables"); 1463 1464 foreach my $export_courseID (@export_courseID) { 1465 1466 my $ce2 = WeBWorK::CourseEnvironment->new( 1467 $ce->{webworkDirs}->{root}, 1468 $ce->{webworkURLs}->{root}, 1469 $ce->{pg}->{directories}->{root}, 1470 $export_courseID, 1471 ); 1472 1473 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1474 1475 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1476 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1477 # export to the admin/templates directory 1478 my $exportFileName = "$export_courseID.exported.xml"; 1479 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName"; 1480 # get a unique name 1481 my $number =1; 1482 while (-e "$exportFilePath.$number.gz") { 1483 $number++; 1484 last if $number>9; 1485 } 1486 if ($number<=9 ) { 1487 $exportFilePath = "$exportFilePath.$number"; 1488 $exportFileName = "$exportFileName.$number"; 1489 } else { 1490 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please 1491 remove some of these files.")); 1492 $exportFilePath = "$exportFilePath.999"; 1493 $exportFileName = "$exportFileName.999"; 1494 } 1495 1496 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath"; 1497 1498 my @errors; 1499 eval { 1500 @errors = dbExport( 1501 db => $db2, 1502 #xml => $fh, 1503 xml => $outputFileHandle, 1504 tables => \@export_tables, 1505 ); 1506 }; 1507 1508 $outputFileHandle->close(); 1509 1510 my $gzipMessage = system( 'gzip', $exportFilePath); 1511 if ( !$gzipMessage ) { 1512 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip. 1513 You may download it with the file manager.")); 1514 } else { 1515 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath")); 1516 } 1517 unlink $exportFilePath; 1518 } # end export of one course 1519 #push @errors, "Fatal exception: $@" if $@; 1520 # 1521 #if (@errors) { 1522 # print CGI::div({class=>"ResultsWithError"}, 1523 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1524 # CGI::ul(CGI::li(\@errors)), 1525 # ); 1526 #} else { 1527 # print CGI::div({class=>"ResultsWithoutError"}, 1528 # CGI::p("Export succeeded."), 1529 # ); 1530 # 1531 # print CGI::div({style=>"text-align: center"}, 1532 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1533 # ); 1534 #} 1535 } 1536 1537 ################################################################################ 1538 1539 sub import_database_form { 1540 my ($self) = @_; 1541 my $r = $self->r; 1542 my $ce = $r->ce; 1543 #my $db = $r->db; 1544 #my $authz = $r->authz; 1545 #my $urlpath = $r->urlpath; 1546 1547 my @tables = keys %{$ce->{dbLayout}}; 1548 1549 my $import_file = $r->param("import_file") || ""; 1550 my $import_courseID = $r->param("import_courseID") || ""; 1551 my @import_tables = $r->param("import_tables"); 1552 my $import_conflict = $r->param("import_conflict") || "skip"; 1553 1554 @import_tables = @tables unless @import_tables; 1555 1556 my @courseIDs = listCourses($ce); 1557 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1558 1559 1560 my %courseLabels; # records... heh. 1561 foreach my $courseID (@courseIDs) { 1562 my $tempCE = WeBWorK::CourseEnvironment->new( 1563 $ce->{webworkDirs}->{root}, 1564 $ce->{webworkURLs}->{root}, 1565 $ce->{pg}->{directories}->{root}, 1566 $courseID, 1567 ); 1568 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1569 } 1570 1571 # find databases: 1572 my $templatesDir = $ce->{courseDirs}->{templates}; 1573 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} }; 1574 my $exempt_dirs = join("|", keys %probLibs); 1575 1576 my @databaseFiles = listFilesRecursive( 1577 $templatesDir, 1578 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!! 1579 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories 1580 0, # match against file name only 1581 1, # prune against path relative to $templatesDir 1582 ); 1583 1584 my %databaseLabels = map { ($_ => $_) } @databaseFiles; 1585 1586 ####### 1587 1588 print CGI::h2("Import Database"); 1589 1590 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1591 print $self->hidden_authen_fields; 1592 print $self->hidden_fields("subDisplay"); 1593 1594 print CGI::table({class=>"FormLayout"}, 1595 CGI::Tr( 1596 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1597 # CGI::td( 1598 # CGI::filefield( 1599 # -name => "import_file", 1600 # -size => 50, 1601 # ), 1602 # ), 1603 CGI::td( 1604 CGI::scrolling_list( 1605 -name => "import_file", 1606 -values => \@databaseFiles, 1607 -default => undef, 1608 -size => 10, 1609 -multiple => 0, 1610 -labels => \%databaseLabels, 1611 ), 1612 1613 ) 1614 ), 1615 CGI::Tr( 1616 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1617 CGI::td( 1618 CGI::checkbox_group( 1619 -name => "import_tables", 1620 -values => \@tables, 1621 -default => \@import_tables, 1622 -linebreak => 1, 1623 ), 1624 ), 1625 ), 1626 CGI::Tr( 1627 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1628 CGI::td( 1629 CGI::scrolling_list( 1630 -name => "import_courseID", 1631 -values => \@courseIDs, 1632 -default => $import_courseID, 1633 -size => 10, 1634 -multiple => 0, 1635 -labels => \%courseLabels, 1636 ), 1637 ), 1638 ), 1639 CGI::Tr( 1640 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1641 CGI::td( 1642 CGI::radio_group( 1643 -name => "import_conflict", 1644 -values => [qw/skip replace/], 1645 -default => $import_conflict, 1646 -linebreak=>'true', 1647 -labels => { 1648 skip => "Skip duplicate records", 1649 replace => "Replace duplicate records", 1650 }, 1651 ), 1652 ), 1653 ), 1654 ); 1655 1656 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1657 1658 print CGI::end_form(); 1659 } 1660 1661 sub import_database_validate { 1662 my ($self) = @_; 1663 my $r = $self->r; 1664 #my $ce = $r->ce; 1665 #my $db = $r->db; 1666 #my $authz = $r->authz; 1667 #my $urlpath = $r->urlpath; 1668 1669 my $import_file = $r->param("import_file") || ""; 1670 my $import_courseID = $r->param("import_courseID") || ""; 1671 my @import_tables = $r->param("import_tables"); 1672 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1673 1674 my @errors; 1675 1676 if ($import_file eq "") { 1677 push @errors, "You must specify a database file to import."; 1678 } 1679 1680 if ($import_courseID eq "") { 1681 push @errors, "You must specify a course name."; 1682 } 1683 1684 unless (@import_tables) { 1685 push @errors, "You must specify at least one table to import."; 1686 } 1687 1688 return @errors; 1689 } 1690 1691 sub do_import_database { 1692 my ($self) = @_; 1693 my $r = $self->r; 1694 my $ce = $r->ce; 1695 #my $db = $r->db; 1696 #my $authz = $r->authz; 1697 my $urlpath = $r->urlpath; 1698 1699 my $import_file = $r->param("import_file"); 1700 my $import_courseID = $r->param("import_courseID"); 1701 my @import_tables = $r->param("import_tables"); 1702 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1703 1704 my $ce2 = WeBWorK::CourseEnvironment->new( 1705 $ce->{webworkDirs}->{root}, 1706 $ce->{webworkURLs}->{root}, 1707 $ce->{pg}->{directories}->{root}, 1708 $import_courseID, 1709 ); 1710 1711 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1712 1713 # locate file 1714 my $templateDir = $ce->{courseDirs}->{templates}; 1715 my $filePath = "$templateDir/$import_file"; 1716 1717 my $gunzipMessage = system( 'gunzip', $filePath); 1718 #FIXME 1719 #warn "gunzip ", $gunzipMessage; 1720 $filePath =~ s/\.gz$//; 1721 #warn "new file path is $filePath"; 1722 my $fileHandle = new IO::File("<$filePath"); 1723 # retrieve upload from upload cache 1724 # my ($id, $hash) = split /\s+/, $import_file; 1725 # my $upload = WeBWorK::Upload->retrieve($id, $hash, 1726 # dir => $ce->{webworkDirs}->{uploadCache} 1727 # ); 1728 1729 my @errors; 1730 1731 eval { 1732 @errors = dbImport( 1733 db => $db2, 1734 # xml => $upload->fileHandle, 1735 xml => $fileHandle, 1736 tables => \@import_tables, 1737 conflict => $import_conflict, 1738 ); 1739 }; 1740 1741 push @errors, "Fatal exception: $@" if $@; 1742 push @errors, $gunzipMessage if $gunzipMessage; 1743 1744 if (@errors) { 1745 print CGI::div({class=>"ResultsWithError"}, 1746 CGI::p("An error occured while importing the database of course $import_courseID:"), 1747 CGI::ul(CGI::li(\@errors)), 1748 ); 1749 } else { 1750 print CGI::div({class=>"ResultsWithoutError"}, 1751 CGI::p("Import succeeded."), 1752 ); 1753 } 1754 } 1755 ########################################################################## 1756 sub archive_course_form { 1757 my ($self) = @_; 1758 my $r = $self->r; 1759 my $ce = $r->ce; 1760 #my $db = $r->db; 1761 #my $authz = $r->authz; 1762 #my $urlpath = $r->urlpath; 1763 1764 my $archive_courseID = $r->param("archive_courseID") || ""; 1765 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1766 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1767 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1768 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1769 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1770 1771 my @courseIDs = listCourses($ce); 1772 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1773 1774 my %courseLabels; # records... heh. 1775 foreach my $courseID (@courseIDs) { 1776 my $tempCE = WeBWorK::CourseEnvironment->new( 1777 $ce->{webworkDirs}->{root}, 1778 $ce->{webworkURLs}->{root}, 1779 $ce->{pg}->{directories}->{root}, 1780 $courseID, 1781 ); 1782 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1783 } 1784 1785 print CGI::h2("archive Course"); 1786 1787 print CGI::start_form("POST", $r->uri); 1788 print $self->hidden_authen_fields; 1789 print $self->hidden_fields("subDisplay"); 1790 1791 print CGI::p("Select a course to archive."); 1792 1793 print CGI::table({class=>"FormLayout"}, 1794 CGI::Tr( 1795 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1796 CGI::td( 1797 CGI::scrolling_list( 1798 -name => "archive_courseID", 1799 -values => \@courseIDs, 1800 -default => $archive_courseID, 1801 -size => 10, 1802 -multiple => 0, 1803 -labels => \%courseLabels, 1804 ), 1805 ), 1806 1807 ), 1808 CGI::Tr( 1809 CGI::th({class=>"LeftHeader"}, "Delete course:"), 1810 CGI::td({-style=>'color:red'}, CGI::checkbox({ 1811 -name=>'delete_course', 1812 -checked=>0, 1813 -value => 1, 1814 -label =>'Delete course after archiving. Caution there is no undo!', 1815 }, 1816 ), 1817 ), 1818 ) 1819 ); 1820 1821 print CGI::p( 1822 "Currently the archive facility is only available for mysql databases. 1823 It depends on the mysqldump application." 1824 ); 1825 1826 1827 print CGI::p({style=>"text-align: center"}, CGI::submit("archive_course", "archive Course")); 1828 1829 print CGI::end_form(); 1830 } 1831 1832 sub archive_course_validate { 1833 my ($self) = @_; 1834 my $r = $self->r; 1835 my $ce = $r->ce; 1836 #my $db = $r->db; 1837 #my $authz = $r->authz; 1838 my $urlpath = $r->urlpath; 1839 1840 my $archive_courseID = $r->param("archive_courseID") || ""; 1841 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1842 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1843 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1844 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1845 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1846 1847 my @errors; 1848 1849 if ($archive_courseID eq "") { 1850 push @errors, "You must specify a course name."; 1851 } elsif ($archive_courseID eq $urlpath->arg("courseID")) { 1852 push @errors, "You cannot archive the course you are currently using."; 1853 } 1854 1855 my $ce2 = WeBWorK::CourseEnvironment->new( 1856 $ce->{webworkDirs}->{root}, 1857 $ce->{webworkURLs}->{root}, 1858 $ce->{pg}->{directories}->{root}, 1859 $archive_courseID, 1860 ); 1861 1862 if ($ce2->{dbLayoutName} eq "sql") { 1863 push @errors, "You must specify the SQL admin username." if $archive_sql_username eq ""; 1864 #push @errors, "You must specify the SQL admin password." if $archive_sql_password eq ""; 1865 #push @errors, "You must specify the SQL database name." if $archive_sql_database eq ""; 1866 } 1867 1868 return @errors; 1869 } 1870 1871 sub archive_course_confirm { 1872 my ($self) = @_; 1873 my $r = $self->r; 1874 my $ce = $r->ce; 1875 #my $db = $r->db; 1876 #my $authz = $r->authz; 1877 #my $urlpath = $r->urlpath; 1878 1879 print CGI::h2("archive Course"); 1880 1881 my $archive_courseID = $r->param("archive_courseID") || ""; 1882 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1883 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1884 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1885 my $delete_course_flag = $r->param("delete_course") || ""; 1886 my $ce2 = WeBWorK::CourseEnvironment->new( 1887 $ce->{webworkDirs}->{root}, 1888 $ce->{webworkURLs}->{root}, 1889 $ce->{pg}->{directories}->{root}, 1890 $archive_courseID, 1891 ); 1892 1893 if ($ce2->{dbLayoutName} ) { 1894 print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID) 1895 . "? "); 1896 print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ". 1897 CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag; 1898 1899 1900 } 1901 1902 print CGI::start_form("POST", $r->uri); 1903 print $self->hidden_authen_fields; 1904 print $self->hidden_fields("subDisplay"); 1905 print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database delete_course/); 1906 1907 print CGI::p({style=>"text-align: center"}, 1908 CGI::submit("decline_archive_course", "Don't archive"), 1909 " ", 1910 CGI::submit("confirm_archive_course", "archive"), 1911 ); 1912 1913 print CGI::end_form(); 1914 } 1915 1916 sub do_archive_course { 1917 my ($self) = @_; 1918 my $r = $self->r; 1919 my $ce = $r->ce; 1920 my $db = $r->db; 1921 #my $authz = $r->authz; 1922 #my $urlpath = $r->urlpath; 1923 1924 my $archive_courseID = $r->param("archive_courseID") || ""; 1925 my $archive_sql_host = $r->param("archive_sql_host") || ""; 1926 my $archive_sql_port = $r->param("archive_sql_port") || ""; 1927 my $archive_sql_username = $r->param("archive_sql_username") || ""; 1928 my $archive_sql_password = $r->param("archive_sql_password") || ""; 1929 my $archive_sql_database = $r->param("archive_sql_database") || ""; 1930 my $delete_course_flag = $r->param("delete_course") || ""; 1931 1932 my $ce2 = WeBWorK::CourseEnvironment->new( 1933 $ce->{webworkDirs}->{root}, 1934 $ce->{webworkURLs}->{root}, 1935 $ce->{pg}->{directories}->{root}, 1936 $archive_courseID, 1937 ); 1938 1939 my %dbOptions; 1940 if ($ce2->{dbLayoutName} eq "sql") { 1941 $dbOptions{host} = $archive_sql_host if $archive_sql_host ne ""; 1942 $dbOptions{port} = $archive_sql_port if $archive_sql_port ne ""; 1943 $dbOptions{username} = $archive_sql_username; 1944 $dbOptions{password} = $archive_sql_password; 1945 $dbOptions{database} = $archive_sql_database || "webwork_$archive_courseID"; 1946 } 1947 1948 eval { 1949 archiveCourse( 1950 courseID => $archive_courseID, 1951 ce => $ce2, 1952 dbOptions => \%dbOptions, 1953 ); 1954 }; 1955 1956 if ($@) { 1957 my $error = $@; 1958 print CGI::div({class=>"ResultsWithError"}, 1959 CGI::p("An error occured while archiving the course $archive_courseID:"), 1960 CGI::tt(CGI::escapeHTML($error)), 1961 ); 1962 } else { 1963 print CGI::div({class=>"ResultsWithoutError"}, 1964 CGI::p("Successfully archived the course $archive_courseID"), 1965 ); 1966 writeLog($ce, "hosted_courses", join("\t", 1967 "\tarchived", 1968 "", 1969 "", 1970 $archive_courseID, 1971 )); 1972 1973 if ($delete_course_flag) { 1974 eval { 1975 deleteCourse( 1976 courseID => $archive_courseID, 1977 ce => $ce2, 1978 dbOptions => \%dbOptions, 1979 ); 1980 }; 1981 1982 if ($@) { 1983 my $error = $@; 1984 print CGI::div({class=>"ResultsWithError"}, 1985 CGI::p("An error occured while deleting the course $archive_courseID:"), 1986 CGI::tt(CGI::escapeHTML($error)), 1987 ); 1988 } else { 1989 # mark the contact person in the admin course as dropped. 1990 # find the contact person for the course by searching the admin classlist. 1991 my @contacts = grep /_$archive_courseID$/, $db->listUsers; 1992 die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1; 1993 #warn "contacts", join(" ", @contacts); 1994 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1995 my $composite_id = $contacts[0]; 1996 1997 # mark the contact person as dropped. 1998 my $User = $db->getUser($composite_id); 1999 my $status_name = 'Drop'; 2000 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 2001 $User->status($status_value); 2002 $db->putUser($User); 2003 2004 print CGI::div({class=>"ResultsWithoutError"}, 2005 CGI::p("Successfully deleted the course $archive_courseID."), 2006 ); 2007 } 2008 2009 2010 } 2011 2012 # print CGI::start_form("POST", $r->uri); 2013 # print $self->hidden_authen_fields; 2014 # print $self->hidden_fields("subDisplay"); 2015 # 2016 # print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),); 2017 # 2018 # print CGI::end_form(); 2019 } 2020 } 2021 ########################################################################## 2022 sub unarchive_course_form { 2023 my ($self) = @_; 2024 my $r = $self->r; 2025 my $ce = $r->ce; 2026 #my $db = $r->db; 2027 #my $authz = $r->authz; 2028 #my $urlpath = $r->urlpath; 2029 2030 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2031 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2032 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2033 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2034 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2035 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2036 2037 # First find courses which have been archived. 2038 my @courseIDs = listArchivedCourses($ce); 2039 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 2040 2041 my %courseLabels; # records... heh. 2042 foreach my $courseID (@courseIDs) { 2043 $courseLabels{$courseID} = $courseID; 2044 } 2045 2046 print CGI::h2("Unarchive Course -- not yet operational"); 2047 2048 print CGI::start_form("POST", $r->uri); 2049 print $self->hidden_authen_fields; 2050 print $self->hidden_fields("subDisplay"); 2051 2052 print CGI::p("Select a course to unarchive."); 2053 2054 print CGI::table({class=>"FormLayout"}, 2055 CGI::Tr( 2056 CGI::th({class=>"LeftHeader"}, "Course Name:"), 2057 CGI::td( 2058 CGI::scrolling_list( 2059 -name => "unarchive_courseID", 2060 -values => \@courseIDs, 2061 -default => $unarchive_courseID, 2062 -size => 10, 2063 -multiple => 0, 2064 -labels => \%courseLabels, 2065 ), 2066 ), 2067 ), 2068 ); 2069 2070 print CGI::p( 2071 "Currently the unarchive facility is only available for mysql databases. 2072 It depends on the mysqldump application." 2073 ); 2074 2075 2076 print CGI::p({style=>"text-align: center"}, CGI::submit("unarchive_course", "Unarchive Course")); 2077 2078 print CGI::end_form(); 2079 } 2080 2081 sub unarchive_course_validate { 2082 my ($self) = @_; 2083 my $r = $self->r; 2084 my $ce = $r->ce; 2085 #my $db = $r->db; 2086 #my $authz = $r->authz; 2087 my $urlpath = $r->urlpath; 2088 2089 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2090 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2091 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2092 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2093 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2094 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2095 2096 my @errors; 2097 2098 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 2099 2100 if ($new_courseID eq "") { 2101 push @errors, "You must specify a course name."; 2102 } elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) { 2103 #Check that a directory for this course doesn't already exist 2104 push @errors, "A directory already exists with the name $new_courseID. 2105 You must first delete this existing course before you can unarchive."; 2106 } 2107 2108 2109 2110 return @errors; 2111 } 2112 2113 sub unarchive_course_confirm { 2114 my ($self) = @_; 2115 my $r = $self->r; 2116 my $ce = $r->ce; 2117 #my $db = $r->db; 2118 #my $authz = $r->authz; 2119 #my $urlpath = $r->urlpath; 2120 2121 print CGI::h2("Unarchive Course"); 2122 2123 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2124 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2125 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2126 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2127 2128 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 2129 2130 2131 2132 print CGI::start_form("POST", $r->uri); 2133 print CGI::p($unarchive_courseID," to course ", 2134 CGI::input({-name=>'new_courseID', -value=>$new_courseID}) 2135 ); 2136 2137 print $self->hidden_authen_fields; 2138 print $self->hidden_fields("subDisplay"); 2139 print $self->hidden_fields(qw/unarchive_courseID 2140 unarchive_sql_host 2141 unarchive_sql_port 2142 unarchive_sql_username 2143 unarchive_sql_password 2144 unarchive_sql_database/); 2145 2146 print CGI::p({style=>"text-align: center"}, 2147 CGI::submit("decline_unarchive_course", "Don't unarchive"), 2148 " ", 2149 CGI::submit("confirm_unarchive_course", "unarchive"), 2150 ); 2151 2152 print CGI::end_form(); 2153 } 2154 2155 sub do_unarchive_course { 2156 my ($self) = @_; 2157 my $r = $self->r; 2158 my $ce = $r->ce; 2159 #my $db = $r->db; 2160 #my $authz = $r->authz; 2161 my $urlpath = $r->urlpath; 2162 my $new_courseID = $r->param("new_courseID") || ""; 2163 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2164 my $unarchive_sql_host = $r->param("unarchive_sql_host") || ""; 2165 my $unarchive_sql_port = $r->param("unarchive_sql_port") || ""; 2166 my $unarchive_sql_username = $r->param("unarchive_sql_username") || ""; 2167 my $unarchive_sql_password = $r->param("unarchive_sql_password") || ""; 2168 my $unarchive_sql_database = $r->param("unarchive_sql_database") || ""; 2169 2170 2171 my %dbOptions; 2172 2173 eval { 2174 unarchiveCourse( 2175 courseID => $new_courseID, 2176 archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID", 2177 ce => $ce , # $ce2, 2178 dbOptions => undef, 2179 ); 2180 }; 2181 2182 if ($@) { 2183 my $error = $@; 2184 print CGI::div({class=>"ResultsWithError"}, 2185 CGI::p("An error occured while archiving the course $unarchive_courseID:"), 2186 CGI::tt(CGI::escapeHTML($error)), 2187 ); 2188 } else { 2189 print CGI::div({class=>"ResultsWithoutError"}, 2190 CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"), 2191 ); 2192 writeLog($ce, "hosted_courses", join("\t", 2193 "\tunarchived", 2194 "", 2195 "", 2196 "$unarchive_courseID to $new_courseID", 2197 )); 2198 2199 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 2200 courseID => $new_courseID); 2201 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 2202 print CGI::div({style=>"text-align: center"}, 2203 CGI::a({href=>$newCourseURL}, "Log into $new_courseID"), 2204 ); 2205 # print CGI::start_form("POST", $r->uri); 2206 # print $self->hidden_authen_fields; 2207 # print $self->hidden_fields("subDisplay"); 2208 # 2209 # print CGI::p({style=>"text-align: center"}, CGI::submit("decline_unarchive_course", "OK"),); 2210 # 2211 # print CGI::end_form(); 2212 } 2213 } 2214 2215 ################################################################################ 2216 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |