Parent Directory
| 
Revision Log
support incremental sending of exported databases (still slow though).
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.22 2004/06/24 20:54:52 sh002i Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::CourseAdmin; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI::Pretty qw(); 29 use Data::Dumper; 30 use File::Temp qw/tempfile/; 31 use WeBWorK::CourseEnvironment; 32 use WeBWorK::Utils qw(cryptPassword writeLog); 33 use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses); 34 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 35 36 sub pre_header_initialize { 37 my ($self) = @_; 38 my $r = $self->r; 39 my $ce = $r->ce; 40 my $db = $r->db; 41 my $authz = $r->authz; 42 my $urlpath = $r->urlpath; 43 my $user = $r->param('user'); 44 45 # check permissions 46 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 47 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 48 return; 49 } 50 51 ## if the user is asking for the downloaded database... 52 #if (defined $r->param("download_exported_database")) { 53 # my $courseID = $r->param("export_courseID"); 54 # my $random_chars = $r->param("download_exported_database"); 55 # 56 # die "courseID not specified" unless defined $courseID; 57 # die "invalid file specification" unless $random_chars =~ m/^\w+$/; 58 # 59 # my $tempdir = $ce->{webworkDirs}->{tmp}; 60 # my $export_file = "$tempdir/db_export_$random_chars"; 61 # 62 # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0); 63 # 64 # return ""; 65 #} 66 # 67 ## otherwise... 68 69 my @errors; 70 my $method_to_call; 71 72 my $subDisplay = $r->param("subDisplay"); 73 if (defined $subDisplay) { 74 75 if ($subDisplay eq "add_course") { 76 if (defined $r->param("add_course")) { 77 @errors = $self->add_course_validate; 78 if (@errors) { 79 $method_to_call = "add_course_form"; 80 } else { 81 $method_to_call = "do_add_course"; 82 } 83 } else { 84 $method_to_call = "add_course_form"; 85 } 86 } 87 88 elsif ($subDisplay eq "delete_course") { 89 if (defined $r->param("delete_course")) { 90 # validate or confirm 91 @errors = $self->delete_course_validate; 92 if (@errors) { 93 $method_to_call = "delete_course_form"; 94 } else { 95 $method_to_call = "delete_course_confirm"; 96 } 97 } elsif (defined $r->param("confirm_delete_course")) { 98 # validate and delete 99 @errors = $self->delete_course_validate; 100 if (@errors) { 101 $method_to_call = "delete_course_form"; 102 } else { 103 $method_to_call = "do_delete_course"; 104 } 105 } else { 106 # form only 107 $method_to_call = "delete_course_form"; 108 } 109 } 110 111 elsif ($subDisplay eq "export_database") { 112 if (defined $r->param("export_database")) { 113 @errors = $self->export_database_validate; 114 if (@errors) { 115 $method_to_call = "export_database_form"; 116 } else { 117 # we have to do something special here, since we're sending 118 # the database as we export it. $method_to_call still gets 119 # set here, but it gets caught by header() and content() 120 # below instead of by body(). 121 $method_to_call = "do_export_database"; 122 } 123 } else { 124 $method_to_call = "export_database_form"; 125 } 126 } 127 128 elsif ($subDisplay eq "import_database") { 129 if (defined $r->param("import_database")) { 130 @errors = $self->import_database_validate; 131 if (@errors) { 132 $method_to_call = "import_database_form"; 133 } else { 134 $method_to_call = "do_import_database"; 135 } 136 } else { 137 $method_to_call = "import_database_form"; 138 } 139 } 140 141 else { 142 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 143 } 144 145 } 146 147 $self->{errors} = \@errors; 148 $self->{method_to_call} = $method_to_call; 149 } 150 151 sub header { 152 my ($self) = @_; 153 my $method_to_call = $self->{method_to_call}; 154 if (defined $method_to_call and $method_to_call eq "do_export_database") { 155 my $r = $self->r; 156 my $courseID = $r->param("export_courseID"); 157 $r->content_type("application/octet-stream"); 158 $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 159 $r->send_http_header; 160 } else { 161 $self->SUPER::header; 162 } 163 } 164 165 # sends: 166 # HTTP/1.1 200 OK 167 # Date: Fri, 09 Jul 2004 19:05:55 GMT 168 # Server: Apache/1.3.27 (Unix) mod_perl/1.27 169 # Content-Disposition: attachment; filename="mth143_database.xml" 170 # Connection: close 171 # Content-Type: application/octet-stream 172 173 sub content { 174 my ($self) = @_; 175 my $method_to_call = $self->{method_to_call}; 176 if (defined $method_to_call and $method_to_call eq "do_export_database") { 177 $self->do_export_database; 178 } else { 179 $self->SUPER::content; 180 } 181 } 182 183 sub body { 184 my ($self) = @_; 185 my $r = $self->r; 186 my $ce = $r->ce; 187 my $db = $r->db; 188 my $authz = $r->authz; 189 my $urlpath = $r->urlpath; 190 191 my $user = $r->param('user'); 192 193 # check permissions 194 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 195 return ""; 196 } 197 198 print CGI::p({style=>"text-align: center"}, 199 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 200 " | ", 201 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 202 " | ", 203 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 204 " | ", 205 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 206 ); 207 208 print CGI::hr(); 209 210 my @errors = @{$self->{errors}}; 211 my $method_to_call = $self->{method_to_call}; 212 213 if (@errors) { 214 print CGI::div({class=>"ResultsWithError"}, 215 CGI::p("Please correct the following errors and try again:"), 216 CGI::ul(CGI::li(\@errors)), 217 ); 218 } 219 220 if (defined $method_to_call and $method_to_call ne "") { 221 $self->$method_to_call; 222 } 223 224 return ""; 225 } 226 227 ################################################################################ 228 229 sub add_course_form { 230 my ($self) = @_; 231 my $r = $self->r; 232 my $ce = $r->ce; 233 #my $db = $r->db; 234 #my $authz = $r->authz; 235 #my $urlpath = $r->urlpath; 236 237 my $add_courseID = $r->param("add_courseID") || ""; 238 my $add_courseTitle = $r->param("add_courseTitle") || ""; 239 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 240 241 my $add_admin_users = $r->param("add_admin_users") || ""; 242 243 my $add_initial_userID = $r->param("add_initial_userID") || ""; 244 my $add_initial_password = $r->param("add_initial_password") || ""; 245 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 246 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 247 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 248 my $add_initial_email = $r->param("add_initial_email") || ""; 249 250 my $add_templates_course = $r->param("add_templates_course") || ""; 251 252 my $add_dbLayout = $r->param("add_dbLayout") || ""; 253 my $add_sql_host = $r->param("add_sql_host") || ""; 254 my $add_sql_port = $r->param("add_sql_port") || ""; 255 my $add_sql_username = $r->param("add_sql_username") || ""; 256 my $add_sql_password = $r->param("add_sql_password") || ""; 257 my $add_sql_database = $r->param("add_sql_database") || ""; 258 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 259 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 260 261 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 262 263 my $ce2 = WeBWorK::CourseEnvironment->new( 264 $ce->{webworkDirs}->{root}, 265 $ce->{webworkURLs}->{root}, 266 $ce->{pg}->{directories}->{root}, 267 "COURSENAME", 268 ); 269 270 my $dbi_source = do { 271 # find the most common SQL source (stolen from CourseManagement.pm) 272 my %sources; 273 foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) { 274 $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++; 275 } 276 my $source; 277 if (keys %sources > 1) { 278 foreach my $curr (keys %sources) { 279 $source = $curr if not defined $source or 280 $sources{$curr} > $sources{$source}; 281 } 282 } else { 283 ($source) = keys %sources; 284 } 285 $source; 286 }; 287 288 my @existingCourses = listCourses($ce); 289 @existingCourses = sort @existingCourses; 290 291 print CGI::h2("Add Course"); 292 293 print CGI::start_form("POST", $r->uri); 294 print $self->hidden_authen_fields; 295 print $self->hidden_fields("subDisplay"); 296 297 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 298 299 print CGI::table({class=>"FormLayout"}, 300 CGI::Tr( 301 CGI::th({class=>"LeftHeader"}, "Course ID:"), 302 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 303 ), 304 CGI::Tr( 305 CGI::th({class=>"LeftHeader"}, "Course Title:"), 306 CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)), 307 ), 308 CGI::Tr( 309 CGI::th({class=>"LeftHeader"}, "Institution:"), 310 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)), 311 ), 312 ); 313 314 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 315 316 print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course")); 317 318 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."); 319 320 print CGI::table({class=>"FormLayout"}, CGI::Tr( 321 CGI::td( 322 CGI::table({class=>"FormLayout"}, 323 CGI::Tr( 324 CGI::th({class=>"LeftHeader"}, "User ID:"), 325 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)), 326 ), 327 CGI::Tr( 328 CGI::th({class=>"LeftHeader"}, "Password:"), 329 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 330 ), 331 CGI::Tr( 332 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 333 CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)), 334 ), 335 ), 336 ), 337 CGI::td( 338 CGI::table({class=>"FormLayout"}, 339 CGI::Tr( 340 CGI::th({class=>"LeftHeader"}, "First Name:"), 341 CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)), 342 ), 343 CGI::Tr( 344 CGI::th({class=>"LeftHeader"}, "Last Name:"), 345 CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)), 346 ), 347 CGI::Tr( 348 CGI::th({class=>"LeftHeader"}, "Email Address:"), 349 CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)), 350 ), 351 ), 352 353 ), 354 )); 355 356 print CGI::p("To copy problem templates from an existing course, select the course below."); 357 358 print CGI::table({class=>"FormLayout"}, 359 CGI::Tr( 360 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 361 CGI::td( 362 CGI::popup_menu( 363 -name => "add_templates_course", 364 -values => [ "", @existingCourses ], 365 -default => $add_templates_course, 366 #-size => 10, 367 #-multiple => 0, 368 #-labels => \%courseLabels, 369 ), 370 371 ), 372 ), 373 ); 374 375 print CGI::p("Select a database layout below."); 376 377 foreach my $dbLayout (@dbLayouts) { 378 print CGI::start_table({class=>"FormLayout"}); 379 380 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 381 print CGI::Tr( 382 CGI::td({style=>"text-align: right"}, 383 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 384 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 385 ), 386 CGI::td($dbLayout), 387 ); 388 389 print CGI::start_Tr(); 390 print CGI::td(); # for indentation :( 391 print CGI::start_td(); 392 393 if ($dbLayout eq "sql") { 394 print CGI::start_table({class=>"FormLayout"}); 395 print CGI::Tr(CGI::td({colspan=>2}, 396 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database." 397 ) 398 ); 399 print CGI::Tr( 400 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 401 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)), 402 ); 403 print CGI::Tr( 404 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 405 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)), 406 ); 407 408 print CGI::Tr(CGI::td({colspan=>2}, 409 "The optionial SQL settings you enter below must match the settings in the DBI source" 410 . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME") 411 . " with the course name you entered above." 412 ) 413 ); 414 print CGI::Tr( 415 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 416 CGI::td( 417 CGI::textfield("add_sql_host", $add_sql_host, 25), 418 CGI::br(), 419 CGI::small("Leave blank to use the default host."), 420 ), 421 ); 422 print CGI::Tr( 423 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 424 CGI::td( 425 CGI::textfield("add_sql_port", $add_sql_port, 25), 426 CGI::br(), 427 CGI::small("Leave blank to use the default port."), 428 ), 429 ); 430 431 print CGI::Tr( 432 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 433 CGI::td( 434 CGI::textfield("add_sql_database", $add_sql_database, 25), 435 CGI::br(), 436 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 437 ), 438 ); 439 print CGI::Tr( 440 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 441 CGI::td( 442 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25), 443 CGI::br(), 444 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."), 445 ), 446 ); 447 print CGI::end_table(); 448 } elsif ($dbLayout eq "gdbm") { 449 print CGI::start_table({class=>"FormLayout"}); 450 print CGI::Tr( 451 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 452 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)), 453 ); 454 print CGI::end_table(); 455 } 456 457 print CGI::end_td(); 458 print CGI::end_Tr(); 459 print CGI::end_table(); 460 } 461 462 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 463 464 print CGI::end_form(); 465 } 466 467 sub add_course_validate { 468 my ($self) = @_; 469 my $r = $self->r; 470 my $ce = $r->ce; 471 #my $db = $r->db; 472 #my $authz = $r->authz; 473 #my $urlpath = $r->urlpath; 474 475 my $add_courseID = $r->param("add_courseID") || ""; 476 my $add_courseTitle = $r->param("add_courseTitle") || ""; 477 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 478 479 my $add_admin_users = $r->param("add_admin_users") || ""; 480 481 my $add_initial_userID = $r->param("add_initial_userID") || ""; 482 my $add_initial_password = $r->param("add_initial_password") || ""; 483 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 484 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 485 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 486 my $add_initial_email = $r->param("add_initial_email") || ""; 487 488 my $add_templates_course = $r->param("add_templates_course") || ""; 489 490 my $add_dbLayout = $r->param("add_dbLayout") || ""; 491 my $add_sql_host = $r->param("add_sql_host") || ""; 492 my $add_sql_port = $r->param("add_sql_port") || ""; 493 my $add_sql_username = $r->param("add_sql_username") || ""; 494 my $add_sql_password = $r->param("add_sql_password") || ""; 495 my $add_sql_database = $r->param("add_sql_database") || ""; 496 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 497 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 498 499 my @errors; 500 501 if ($add_courseID eq "") { 502 push @errors, "You must specify a course ID."; 503 } 504 if (grep { $add_courseID eq $_ } listCourses($ce)) { 505 push @errors, "A course with ID $add_courseID already exists."; 506 } 507 if ($add_courseTitle eq "") { 508 push @errors, "You must specify a course title."; 509 } 510 if ($add_courseInstitution eq "") { 511 push @errors, "You must specify an institution for this course."; 512 } 513 514 if ($add_initial_userID ne "") { 515 if ($add_initial_password eq "") { 516 push @errors, "You must specify a password for the initial instructor."; 517 } 518 if ($add_initial_confirmPassword eq "") { 519 push @errors, "You must confirm the password for the initial instructor."; 520 } 521 if ($add_initial_password ne $add_initial_confirmPassword) { 522 push @errors, "The password and password confirmation for the instructor must match."; 523 } 524 if ($add_initial_firstName eq "") { 525 push @errors, "You must specify a first name for the initial instructor."; 526 } 527 if ($add_initial_lastName eq "") { 528 push @errors, "You must specify a last name for the initial instructor."; 529 } 530 if ($add_initial_email eq "") { 531 push @errors, "You must specify an email address for the initial instructor."; 532 } 533 } 534 535 if ($add_dbLayout eq "") { 536 push @errors, "You must select a database layout."; 537 } else { 538 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 539 if ($add_dbLayout eq "sql") { 540 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 541 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 542 } elsif ($add_dbLayout eq "gdbm") { 543 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 544 } 545 } else { 546 push @errors, "The database layout $add_dbLayout doesn't exist."; 547 } 548 } 549 550 return @errors; 551 } 552 553 sub do_add_course { 554 my ($self) = @_; 555 my $r = $self->r; 556 my $ce = $r->ce; 557 my $db = $r->db; 558 #my $authz = $r->authz; 559 my $urlpath = $r->urlpath; 560 561 my $add_courseID = $r->param("add_courseID") || ""; 562 my $add_courseTitle = $r->param("add_courseTitle") || ""; 563 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 564 565 my $add_admin_users = $r->param("add_admin_users") || ""; 566 567 my $add_initial_userID = $r->param("add_initial_userID") || ""; 568 my $add_initial_password = $r->param("add_initial_password") || ""; 569 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 570 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 571 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 572 my $add_initial_email = $r->param("add_initial_email") || ""; 573 574 my $add_templates_course = $r->param("add_templates_course") || ""; 575 576 my $add_dbLayout = $r->param("add_dbLayout") || ""; 577 my $add_sql_host = $r->param("add_sql_host") || ""; 578 my $add_sql_port = $r->param("add_sql_port") || ""; 579 my $add_sql_username = $r->param("add_sql_username") || ""; 580 my $add_sql_password = $r->param("add_sql_password") || ""; 581 my $add_sql_database = $r->param("add_sql_database") || ""; 582 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 583 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 584 585 my $ce2 = WeBWorK::CourseEnvironment->new( 586 $ce->{webworkDirs}->{root}, 587 $ce->{webworkURLs}->{root}, 588 $ce->{pg}->{directories}->{root}, 589 $add_courseID, 590 ); 591 592 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 593 594 if ($add_initial_email ne "") { 595 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 596 $courseOptions{feedbackRecipients} = [ $add_initial_email ]; 597 } 598 599 if ($add_dbLayout eq "gdbm") { 600 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 601 } 602 603 my %dbOptions; 604 if ($add_dbLayout eq "sql") { 605 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 606 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 607 $dbOptions{username} = $add_sql_username; 608 $dbOptions{password} = $add_sql_password; 609 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID"; 610 $dbOptions{wwhost} = $add_sql_wwhost; 611 } 612 613 my @users; 614 615 # copy users from current (admin) course if desired 616 if ($add_admin_users ne "") { 617 foreach my $userID ($db->listUsers) { 618 my $User = $db->getUser($userID); 619 my $Password = $db->getPassword($userID); 620 my $PermissionLevel = $db->getPermissionLevel($userID); 621 push @users, [ $User, $Password, $PermissionLevel ]; 622 } 623 } 624 625 # add initial instructor if desired 626 if ($add_initial_userID ne "") { 627 my $User = $db->newUser( 628 user_id => $add_initial_userID, 629 first_name => $add_initial_firstName, 630 last_name => $add_initial_lastName, 631 student_id => $add_initial_userID, 632 email_address => $add_initial_email, 633 status => "C", 634 ); 635 my $Password = $db->newPassword( 636 user_id => $add_initial_userID, 637 password => cryptPassword($add_initial_password), 638 ); 639 my $PermissionLevel = $db->newPermissionLevel( 640 user_id => $add_initial_userID, 641 permission => "10", 642 ); 643 push @users, [ $User, $Password, $PermissionLevel ]; 644 } 645 646 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users; 647 648 my %optional_arguments; 649 if ($add_templates_course ne "") { 650 $optional_arguments{templatesFrom} = $add_templates_course; 651 } 652 653 eval { 654 addCourse( 655 courseID => $add_courseID, 656 ce => $ce2, 657 courseOptions => \%courseOptions, 658 dbOptions => \%dbOptions, 659 users => \@users, 660 %optional_arguments, 661 ); 662 }; 663 if ($@) { 664 my $error = $@; 665 print CGI::div({class=>"ResultsWithError"}, 666 CGI::p("An error occured while creating the course $add_courseID:"), 667 CGI::tt(CGI::escapeHTML($error)), 668 ); 669 # get rid of any partially built courses 670 # FIXME -- this is too fragile 671 unless ($error =~ /course exists/) { 672 eval { 673 deleteCourse( 674 courseID => $add_courseID, 675 ce => $ce2, 676 dbOptions => \%dbOptions, 677 ); 678 } 679 } 680 } else { 681 #log the action 682 writeLog($ce, "hosted_courses", join("\t", 683 "\tAdded", 684 $add_courseInstitution, 685 $add_courseTitle, 686 $add_courseID, 687 $add_initial_firstName, 688 $add_initial_lastName, 689 $add_initial_email, 690 )); 691 # add contact to admin course as student? 692 # FIXME -- should we do this? 693 print CGI::div({class=>"ResultsWithoutError"}, 694 CGI::p("Successfully created the course $add_courseID"), 695 ); 696 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 697 courseID => $add_courseID); 698 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 699 print CGI::div({style=>"text-align: center"}, 700 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 701 ); 702 } 703 704 705 } 706 707 ################################################################################ 708 709 sub delete_course_form { 710 my ($self) = @_; 711 my $r = $self->r; 712 my $ce = $r->ce; 713 #my $db = $r->db; 714 #my $authz = $r->authz; 715 #my $urlpath = $r->urlpath; 716 717 my $delete_courseID = $r->param("delete_courseID") || ""; 718 my $delete_sql_host = $r->param("delete_sql_host") || ""; 719 my $delete_sql_port = $r->param("delete_sql_port") || ""; 720 my $delete_sql_username = $r->param("delete_sql_username") || ""; 721 my $delete_sql_password = $r->param("delete_sql_password") || ""; 722 my $delete_sql_database = $r->param("delete_sql_database") || ""; 723 724 my @courseIDs = listCourses($ce); 725 @courseIDs = sort @courseIDs; 726 727 my %courseLabels; # records... heh. 728 foreach my $courseID (@courseIDs) { 729 my $tempCE = WeBWorK::CourseEnvironment->new( 730 $ce->{webworkDirs}->{root}, 731 $ce->{webworkURLs}->{root}, 732 $ce->{pg}->{directories}->{root}, 733 $courseID, 734 ); 735 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 736 } 737 738 print CGI::h2("Delete Course"); 739 740 print CGI::start_form("POST", $r->uri); 741 print $self->hidden_authen_fields; 742 print $self->hidden_fields("subDisplay"); 743 744 print CGI::p("Select a course to delete."); 745 746 print CGI::table({class=>"FormLayout"}, 747 CGI::Tr( 748 CGI::th({class=>"LeftHeader"}, "Course Name:"), 749 CGI::td( 750 CGI::scrolling_list( 751 -name => "delete_courseID", 752 -values => \@courseIDs, 753 -default => $delete_courseID, 754 -size => 10, 755 -multiple => 0, 756 -labels => \%courseLabels, 757 ), 758 ), 759 ), 760 ); 761 762 print CGI::p( 763 "If the course's database layout (indicated in parentheses above) is " 764 . CGI::b("sql") . ", supply the SQL connections information requested below." 765 ); 766 767 print CGI::start_table({class=>"FormLayout"}); 768 print CGI::Tr( 769 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 770 CGI::td( 771 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 772 CGI::br(), 773 CGI::small("Leave blank to use the default host."), 774 ), 775 ); 776 print CGI::Tr( 777 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 778 CGI::td( 779 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 780 CGI::br(), 781 CGI::small("Leave blank to use the default port."), 782 ), 783 ); 784 print CGI::Tr( 785 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 786 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 787 ); 788 print CGI::Tr( 789 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 790 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 791 ); 792 print CGI::Tr( 793 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 794 CGI::td( 795 CGI::textfield("delete_sql_database", $delete_sql_database, 25), 796 CGI::br(), 797 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 798 ), 799 ); 800 print CGI::end_table(); 801 802 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 803 804 print CGI::end_form(); 805 } 806 807 sub delete_course_validate { 808 my ($self) = @_; 809 my $r = $self->r; 810 my $ce = $r->ce; 811 #my $db = $r->db; 812 #my $authz = $r->authz; 813 my $urlpath = $r->urlpath; 814 815 my $delete_courseID = $r->param("delete_courseID") || ""; 816 my $delete_sql_host = $r->param("delete_sql_host") || ""; 817 my $delete_sql_port = $r->param("delete_sql_port") || ""; 818 my $delete_sql_username = $r->param("delete_sql_username") || ""; 819 my $delete_sql_password = $r->param("delete_sql_password") || ""; 820 my $delete_sql_database = $r->param("delete_sql_database") || ""; 821 822 my @errors; 823 824 if ($delete_courseID eq "") { 825 push @errors, "You must specify a course name."; 826 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 827 push @errors, "You cannot delete the course you are currently using."; 828 } 829 830 my $ce2 = WeBWorK::CourseEnvironment->new( 831 $ce->{webworkDirs}->{root}, 832 $ce->{webworkURLs}->{root}, 833 $ce->{pg}->{directories}->{root}, 834 $delete_courseID, 835 ); 836 837 if ($ce2->{dbLayoutName} eq "sql") { 838 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 839 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 840 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 841 } 842 843 return @errors; 844 } 845 846 sub delete_course_confirm { 847 my ($self) = @_; 848 my $r = $self->r; 849 my $ce = $r->ce; 850 #my $db = $r->db; 851 #my $authz = $r->authz; 852 #my $urlpath = $r->urlpath; 853 854 print CGI::h2("Delete Course"); 855 856 my $delete_courseID = $r->param("delete_courseID") || ""; 857 my $delete_sql_host = $r->param("delete_sql_host") || ""; 858 my $delete_sql_port = $r->param("delete_sql_port") || ""; 859 my $delete_sql_database = $r->param("delete_sql_database") || ""; 860 861 my $ce2 = WeBWorK::CourseEnvironment->new( 862 $ce->{webworkDirs}->{root}, 863 $ce->{webworkURLs}->{root}, 864 $ce->{pg}->{directories}->{root}, 865 $delete_courseID, 866 ); 867 868 if ($ce2->{dbLayoutName} eq "sql") { 869 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 870 . "? All course files and data and the following database will be destroyed." 871 . " There is no undo available."); 872 873 print CGI::table({class=>"FormLayout"}, 874 CGI::Tr( 875 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 876 CGI::td($delete_sql_host || "system default"), 877 ), 878 CGI::Tr( 879 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 880 CGI::td($delete_sql_port || "system default"), 881 ), 882 CGI::Tr( 883 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 884 CGI::td($delete_sql_database || "webwork_$delete_courseID"), 885 ), 886 ); 887 } else { 888 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 889 . "? All course files and data will be destroyed. There is no undo available."); 890 } 891 892 print CGI::start_form("POST", $r->uri); 893 print $self->hidden_authen_fields; 894 print $self->hidden_fields("subDisplay"); 895 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 896 897 print CGI::p({style=>"text-align: center"}, 898 CGI::submit("decline_delete_course", "Don't delete"), 899 " ", 900 CGI::submit("confirm_delete_course", "Delete"), 901 ); 902 903 print CGI::end_form(); 904 } 905 906 sub do_delete_course { 907 my ($self) = @_; 908 my $r = $self->r; 909 my $ce = $r->ce; 910 #my $db = $r->db; 911 #my $authz = $r->authz; 912 #my $urlpath = $r->urlpath; 913 914 my $delete_courseID = $r->param("delete_courseID") || ""; 915 my $delete_sql_host = $r->param("delete_sql_host") || ""; 916 my $delete_sql_port = $r->param("delete_sql_port") || ""; 917 my $delete_sql_username = $r->param("delete_sql_username") || ""; 918 my $delete_sql_password = $r->param("delete_sql_password") || ""; 919 my $delete_sql_database = $r->param("delete_sql_database") || ""; 920 921 my $ce2 = WeBWorK::CourseEnvironment->new( 922 $ce->{webworkDirs}->{root}, 923 $ce->{webworkURLs}->{root}, 924 $ce->{pg}->{directories}->{root}, 925 $delete_courseID, 926 ); 927 928 my %dbOptions; 929 if ($ce2->{dbLayoutName} eq "sql") { 930 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 931 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 932 $dbOptions{username} = $delete_sql_username; 933 $dbOptions{password} = $delete_sql_password; 934 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID"; 935 } 936 937 eval { 938 deleteCourse( 939 courseID => $delete_courseID, 940 ce => $ce2, 941 dbOptions => \%dbOptions, 942 ); 943 }; 944 945 if ($@) { 946 my $error = $@; 947 print CGI::div({class=>"ResultsWithError"}, 948 CGI::p("An error occured while deleting the course $delete_courseID:"), 949 CGI::tt(CGI::escapeHTML($error)), 950 ); 951 } else { 952 print CGI::div({class=>"ResultsWithoutError"}, 953 CGI::p("Successfully deleted the course $delete_courseID."), 954 ); 955 writeLog($ce, "hosted_courses", join("\t", 956 "\tDeleted", 957 "", 958 "", 959 $delete_courseID, 960 )); 961 print CGI::start_form("POST", $r->uri); 962 print $self->hidden_authen_fields; 963 print $self->hidden_fields("subDisplay"); 964 965 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 966 967 print CGI::end_form(); 968 } 969 } 970 971 ################################################################################ 972 973 sub export_database_form { 974 my ($self) = @_; 975 my $r = $self->r; 976 my $ce = $r->ce; 977 #my $db = $r->db; 978 #my $authz = $r->authz; 979 #my $urlpath = $r->urlpath; 980 981 my @tables = keys %{$ce->{dbLayout}}; 982 983 my $export_courseID = $r->param("export_courseID") || ""; 984 my @export_tables = $r->param("export_tables"); 985 986 @export_tables = @tables unless @export_tables; 987 988 my @courseIDs = listCourses($ce); 989 @courseIDs = sort @courseIDs; 990 991 my %courseLabels; # records... heh. 992 foreach my $courseID (@courseIDs) { 993 my $tempCE = WeBWorK::CourseEnvironment->new( 994 $ce->{webworkDirs}->{root}, 995 $ce->{webworkURLs}->{root}, 996 $ce->{pg}->{directories}->{root}, 997 $courseID, 998 ); 999 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1000 } 1001 1002 print CGI::h2("Export Database"); 1003 1004 print CGI::start_form("GET", $r->uri); 1005 print $self->hidden_authen_fields; 1006 print $self->hidden_fields("subDisplay"); 1007 1008 print CGI::p("Select a course to export the course's database."); 1009 1010 print CGI::table({class=>"FormLayout"}, 1011 CGI::Tr( 1012 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1013 CGI::td( 1014 CGI::scrolling_list( 1015 -name => "export_courseID", 1016 -values => \@courseIDs, 1017 -default => $export_courseID, 1018 -size => 10, 1019 -multiple => 0, 1020 -labels => \%courseLabels, 1021 ), 1022 ), 1023 ), 1024 CGI::Tr( 1025 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1026 CGI::td( 1027 CGI::checkbox_group( 1028 -name => "export_tables", 1029 -values => \@tables, 1030 -default => \@export_tables, 1031 -linebreak => 1, 1032 ), 1033 ), 1034 ), 1035 ); 1036 1037 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 1038 1039 print CGI::end_form(); 1040 } 1041 1042 sub export_database_validate { 1043 my ($self) = @_; 1044 my $r = $self->r; 1045 #my $ce = $r->ce; 1046 #my $db = $r->db; 1047 #my $authz = $r->authz; 1048 #my $urlpath = $r->urlpath; 1049 1050 my $export_courseID = $r->param("export_courseID") || ""; 1051 my @export_tables = $r->param("export_tables"); 1052 1053 my @errors; 1054 1055 if ($export_courseID eq "") { 1056 push @errors, "You must specify a course name."; 1057 } 1058 1059 unless (@export_tables) { 1060 push @errors, "You must specify at least one table to export."; 1061 } 1062 1063 return @errors; 1064 } 1065 1066 sub do_export_database { 1067 my ($self) = @_; 1068 my $r = $self->r; 1069 my $ce = $r->ce; 1070 #my $db = $r->db; 1071 #my $authz = $r->authz; 1072 my $urlpath = $r->urlpath; 1073 1074 my $export_courseID = $r->param("export_courseID"); 1075 my @export_tables = $r->param("export_tables"); 1076 1077 my $ce2 = WeBWorK::CourseEnvironment->new( 1078 $ce->{webworkDirs}->{root}, 1079 $ce->{webworkURLs}->{root}, 1080 $ce->{pg}->{directories}->{root}, 1081 $export_courseID, 1082 ); 1083 1084 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1085 1086 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1087 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1088 1089 my @errors; 1090 1091 eval { 1092 @errors = dbExport( 1093 db => $db2, 1094 #xml => $fh, 1095 xml => *STDOUT, 1096 tables => \@export_tables, 1097 ); 1098 }; 1099 1100 #push @errors, "Fatal exception: $@" if $@; 1101 # 1102 #if (@errors) { 1103 # print CGI::div({class=>"ResultsWithError"}, 1104 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1105 # CGI::ul(CGI::li(\@errors)), 1106 # ); 1107 #} else { 1108 # print CGI::div({class=>"ResultsWithoutError"}, 1109 # CGI::p("Export succeeded."), 1110 # ); 1111 # 1112 # print CGI::div({style=>"text-align: center"}, 1113 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1114 # ); 1115 #} 1116 } 1117 1118 ################################################################################ 1119 1120 sub import_database_form { 1121 my ($self) = @_; 1122 my $r = $self->r; 1123 my $ce = $r->ce; 1124 #my $db = $r->db; 1125 #my $authz = $r->authz; 1126 #my $urlpath = $r->urlpath; 1127 1128 my @tables = keys %{$ce->{dbLayout}}; 1129 1130 my $import_file = $r->param("import_file") || ""; 1131 my $import_courseID = $r->param("import_courseID") || ""; 1132 my @import_tables = $r->param("import_tables"); 1133 my $import_conflict = $r->param("import_conflict") || "skip"; 1134 1135 @import_tables = @tables unless @import_tables; 1136 1137 my @courseIDs = listCourses($ce); 1138 @courseIDs = sort @courseIDs; 1139 1140 1141 my %courseLabels; # records... heh. 1142 foreach my $courseID (@courseIDs) { 1143 my $tempCE = WeBWorK::CourseEnvironment->new( 1144 $ce->{webworkDirs}->{root}, 1145 $ce->{webworkURLs}->{root}, 1146 $ce->{pg}->{directories}->{root}, 1147 $courseID, 1148 ); 1149 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1150 } 1151 1152 print CGI::h2("Import Database"); 1153 1154 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1155 print $self->hidden_authen_fields; 1156 print $self->hidden_fields("subDisplay"); 1157 1158 print CGI::table({class=>"FormLayout"}, 1159 CGI::Tr( 1160 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1161 CGI::td( 1162 CGI::filefield( 1163 -name => "import_file", 1164 -size => 50, 1165 ), 1166 ), 1167 ), 1168 CGI::Tr( 1169 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1170 CGI::td( 1171 CGI::checkbox_group( 1172 -name => "import_tables", 1173 -values => \@tables, 1174 -default => \@import_tables, 1175 -linebreak => 1, 1176 ), 1177 ), 1178 ), 1179 CGI::Tr( 1180 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1181 CGI::td( 1182 CGI::scrolling_list( 1183 -name => "import_courseID", 1184 -values => \@courseIDs, 1185 -default => $import_courseID, 1186 -size => 10, 1187 -multiple => 0, 1188 -labels => \%courseLabels, 1189 ), 1190 ), 1191 ), 1192 CGI::Tr( 1193 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1194 CGI::td( 1195 CGI::radio_group( 1196 -name => "import_conflict", 1197 -values => [qw/skip replace/], 1198 -default => $import_conflict, 1199 -linebreak=>'true', 1200 -labels => { 1201 skip => "Skip duplicate records", 1202 replace => "Replace duplicate records", 1203 }, 1204 ), 1205 ), 1206 ), 1207 ); 1208 1209 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1210 1211 print CGI::end_form(); 1212 } 1213 1214 sub import_database_validate { 1215 my ($self) = @_; 1216 my $r = $self->r; 1217 #my $ce = $r->ce; 1218 #my $db = $r->db; 1219 #my $authz = $r->authz; 1220 #my $urlpath = $r->urlpath; 1221 1222 my $import_file = $r->param("import_file") || ""; 1223 my $import_courseID = $r->param("import_courseID") || ""; 1224 my @import_tables = $r->param("import_tables"); 1225 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1226 1227 my @errors; 1228 1229 if ($import_file eq "") { 1230 push @errors, "You must specify a database file to upload."; 1231 } 1232 1233 if ($import_courseID eq "") { 1234 push @errors, "You must specify a course name."; 1235 } 1236 1237 unless (@import_tables) { 1238 push @errors, "You must specify at least one table to import."; 1239 } 1240 1241 return @errors; 1242 } 1243 1244 sub do_import_database { 1245 my ($self) = @_; 1246 my $r = $self->r; 1247 my $ce = $r->ce; 1248 #my $db = $r->db; 1249 #my $authz = $r->authz; 1250 my $urlpath = $r->urlpath; 1251 1252 my $import_file = $r->param("import_file"); 1253 my $import_courseID = $r->param("import_courseID"); 1254 my @import_tables = $r->param("import_tables"); 1255 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1256 1257 my $ce2 = WeBWorK::CourseEnvironment->new( 1258 $ce->{webworkDirs}->{root}, 1259 $ce->{webworkURLs}->{root}, 1260 $ce->{pg}->{directories}->{root}, 1261 $import_courseID, 1262 ); 1263 1264 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1265 1266 # retrieve upload from upload cache 1267 my ($id, $hash) = split /\s+/, $import_file; 1268 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1269 dir => $ce->{webworkDirs}->{uploadCache} 1270 ); 1271 1272 my @errors; 1273 1274 eval { 1275 @errors = dbImport( 1276 db => $db2, 1277 xml => $upload->fileHandle, 1278 tables => \@import_tables, 1279 conflict => $import_conflict, 1280 ); 1281 }; 1282 1283 $upload->dispose; 1284 1285 push @errors, "Fatal exception: $@" if $@; 1286 1287 if (@errors) { 1288 print CGI::div({class=>"ResultsWithError"}, 1289 CGI::p("An error occured while importing the database of course $import_courseID:"), 1290 CGI::ul(CGI::li(\@errors)), 1291 ); 1292 } else { 1293 print CGI::div({class=>"ResultsWithoutError"}, 1294 CGI::p("Import succeeded."), 1295 ); 1296 } 1297 } 1298 1299 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |