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