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