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