Parent Directory
| 
Revision Log
Only someone with professor privileges can use CourseAdministration.pm
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.5 2004/05/07 04:28:54 jj 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::Utils qw(cryptPassword); 32 use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses); 33 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 34 35 # SKEL: If you need to do any processing before the HTTP header is sent, do it 36 # in this method: 37 # 38 sub pre_header_initialize { 39 my ($self) = @_; 40 my $r = $self->r; 41 my $ce = $r->ce; 42 my $db = $r->db; 43 my $authz = $r->authz; 44 my $urlpath = $r->urlpath; 45 my $user = $r->param('user'); 46 47 # check permissions 48 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 49 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 50 return; 51 } 52 53 if (defined $r->param("download_exported_database")) { 54 my $courseID = $r->param("export_courseID"); 55 my $random_chars = $r->param("download_exported_database"); 56 57 die "courseID not specified" unless defined $courseID; 58 die "invalid file specification" unless $random_chars =~ m/^\w+$/; 59 60 my $tempdir = $ce->{webworkDirs}->{tmp}; 61 my $export_file = "$tempdir/db_export_$random_chars"; 62 63 $self->reply_with_file("text/xml", $export_file, "${courseID}_database.xml", 0); 64 } 65 } 66 67 # SKEL: To emit your own HTTP header, uncomment this: 68 # 69 #sub header { 70 # my ($self) = @_; 71 # 72 # # Generate your HTTP header here. 73 # 74 # # If you return something, it will be used as the HTTP status code for this 75 # # request. The Apache::Constants module might be useful for gerating status 76 # # codes. If you don't return anything, the status code "OK" will be used. 77 # return ""; 78 #} 79 80 # SKEL: If you need to do any processing after the HTTP header is sent, but before 81 # any template processing occurs, or you need to calculate values that will be 82 # used in multiple methods, do it in this method: 83 # 84 #sub initialize { 85 # my ($self) = @_; 86 # 87 # # Do your processing here! Don't print or return anything -- store data in 88 # # the self hash for later retrieveal. 89 #} 90 91 # SKEL: If you need to add tags to the document <HEAD>, uncomment this method: 92 # 93 #sub head { 94 # my ($self) = @_; 95 # 96 # # You can print head tags here, like <META>, <SCRIPT>, etc. 97 # 98 # return ""; 99 #} 100 101 # SKEL: To fill in the "info" box (to the right of the main body), use this 102 # method: 103 # 104 #sub info { 105 # my ($self) = @_; 106 # 107 # # Print HTML here. 108 # 109 # return ""; 110 #} 111 112 # SKEL: To provide navigation links, use this method: 113 # 114 #sub nav { 115 # my ($self, $args) = @_; 116 # 117 # # See the documentation of path() and pathMacro() in 118 # # WeBWorK::ContentGenerator for more information. 119 # 120 # return ""; 121 #} 122 123 # SKEL: For a little box for display options, etc., use this method: 124 # 125 #sub options { 126 # my ($self) = @_; 127 # 128 # # Print HTML here. 129 # 130 # return ""; 131 #} 132 133 # SKEL: For a list of sibling objects, use this method: 134 # 135 #sub siblings { 136 # my ($self, $args) = @_; 137 # 138 # # See the documentation of siblings() and siblingsMacro() in 139 # # WeBWorK::ContentGenerator for more information. 140 # # 141 # # Refer to implementations in ProblemSet and Problem. 142 # 143 # return ""; 144 #} 145 146 # SKEL: Okay, here's the body. Most of your stuff will go here: 147 # 148 sub body { 149 my ($self) = @_; 150 my $r = $self->r; 151 my $ce = $r->ce; 152 my $db = $r->db; 153 my $authz = $r->authz; 154 my $urlpath = $r->urlpath; 155 156 my $user = $r->param('user'); 157 158 # check permissions 159 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 160 return ""; 161 } 162 163 print CGI::p({style=>"text-align: center"}, 164 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 165 #" | ", 166 #CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"), 167 " | ", 168 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 169 " | ", 170 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 171 " | ", 172 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 173 ); 174 175 print CGI::hr(); 176 177 my $subDisplay = $r->param("subDisplay"); 178 if (defined $subDisplay) { 179 180 if ($subDisplay eq "add_course") { 181 if (defined $r->param("add_course")) { 182 my @errors = $self->add_course_validate; 183 if (@errors) { 184 print CGI::div({class=>"ResultsWithError"}, 185 CGI::p("Please correct the following errors and try again:"), 186 CGI::ul(CGI::li(\@errors)), 187 ); 188 $self->add_course_form; 189 } else { 190 $self->do_add_course; 191 } 192 } else { 193 $self->add_course_form; 194 } 195 } 196 197 elsif ($subDisplay eq "delete_course") { 198 if (defined $r->param("delete_course")) { 199 # validate or confirm 200 my @errors = $self->delete_course_validate; 201 if (@errors) { 202 print CGI::div({class=>"ResultsWithError"}, 203 CGI::p("Please correct the following errors and try again:"), 204 CGI::ul(CGI::li(\@errors)), 205 ); 206 $self->delete_course_form; 207 } else { 208 $self->delete_course_confirm; 209 } 210 } elsif (defined $r->param("confirm_delete_course")) { 211 # validate and delete 212 my @errors = $self->delete_course_validate; 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 $self->delete_course_form; 219 } else { 220 $self->do_delete_course; 221 } 222 } else { 223 # form only 224 $self->delete_course_form; 225 } 226 } 227 228 elsif ($subDisplay eq "export_database") { 229 if (defined $r->param("export_database")) { 230 my @errors = $self->export_database_validate; 231 if (@errors) { 232 print CGI::div({class=>"ResultsWithError"}, 233 CGI::p("Please correct the following errors and try again:"), 234 CGI::ul(CGI::li(\@errors)), 235 ); 236 $self->export_database_form; 237 } else { 238 $self->do_export_database; 239 } 240 } else { 241 $self->export_database_form; 242 } 243 } 244 245 elsif ($subDisplay eq "import_database") { 246 if (defined $r->param("import_database")) { 247 my @errors = $self->import_database_validate; 248 if (@errors) { 249 print CGI::div({class=>"ResultsWithError"}, 250 CGI::p("Please correct the following errors and try again:"), 251 CGI::ul(CGI::li(\@errors)), 252 ); 253 $self->import_database_form; 254 } else { 255 $self->do_import_database; 256 } 257 } else { 258 $self->import_database_form; 259 } 260 } 261 262 else { 263 print CGI::div({class=>"ResultsWithError"}, 264 "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."); 265 } 266 267 } 268 269 return ""; 270 } 271 272 ################################################################################ 273 274 sub add_course_form { 275 my ($self) = @_; 276 my $r = $self->r; 277 my $ce = $r->ce; 278 #my $db = $r->db; 279 #my $authz = $r->authz; 280 #my $urlpath = $r->urlpath; 281 282 my $add_courseID = $r->param("add_courseID") || ""; 283 my $add_dbLayout = $r->param("add_dbLayout") || ""; 284 my $add_sql_host = $r->param("add_sql_host") || ""; 285 my $add_sql_port = $r->param("add_sql_port") || ""; 286 my $add_sql_username = $r->param("add_sql_username") || ""; 287 my $add_sql_password = $r->param("add_sql_password") || ""; 288 my $add_sql_database = $r->param("add_sql_database") || ""; 289 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 290 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 291 my $add_initial_userID = $r->param("add_initial_userID") || ""; 292 my $add_initial_password = $r->param("add_initial_password") || ""; 293 294 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 295 296 my $ce2 = WeBWorK::CourseEnvironment->new( 297 $ce->{webworkDirs}->{root}, 298 $ce->{webworkURLs}->{root}, 299 $ce->{pg}->{directories}->{root}, 300 "COURSENAME", 301 ); 302 303 my $dbi_source = do { 304 # find the most common SQL source (stolen from CourseManagement.pm) 305 my %sources; 306 foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) { 307 $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++; 308 } 309 my $source; 310 if (keys %sources > 1) { 311 foreach my $curr (keys %sources) { 312 $source = $curr if not defined $source or 313 $sources{$curr} > $sources{$source}; 314 } 315 } else { 316 ($source) = keys %sources; 317 } 318 $source; 319 }; 320 321 print CGI::h2("Add Course"); 322 323 print CGI::start_form("POST", $r->uri); 324 print $self->hidden_authen_fields; 325 print $self->hidden_fields("subDisplay"); 326 327 print CGI::p("Specify a name for the new course."); 328 329 print CGI::table({class=>"FormLayout"}, 330 CGI::Tr( 331 CGI::th({class=>"LeftHeader"}, "Course Name:"), 332 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 333 ), 334 ); 335 336 print CGI::p("Select a database layout below. Some database layouts require additional information."); 337 338 #print CGI::start_Tr(); 339 #print CGI::th({class=>"LeftHeader"}, "Database Layout:"); 340 #print CGI::start_td(); 341 342 foreach my $dbLayout (@dbLayouts) { 343 print CGI::start_table({class=>"FormLayout"}); 344 345 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 346 print CGI::Tr( 347 CGI::td({style=>"text-align: right"}, 348 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 349 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 350 ), 351 CGI::td($dbLayout), 352 ); 353 354 print CGI::start_Tr(); 355 print CGI::td(); # for indentation :( 356 print CGI::start_td(); 357 358 if ($dbLayout eq "sql") { 359 print CGI::p( 360 "The SQL settings you enter below must match the settings in the DBI source", 361 " specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"), 362 " with the course name you entered above." 363 ); 364 print CGI::start_table({class=>"FormLayout"}); 365 print CGI::Tr( 366 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 367 CGI::td( 368 CGI::textfield("add_sql_host", $add_sql_host, 25), 369 CGI::br(), 370 CGI::small("Leave blank to use the default host."), 371 ), 372 ); 373 print CGI::Tr( 374 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 375 CGI::td( 376 CGI::textfield("add_sql_port", $add_sql_port, 25), 377 CGI::br(), 378 CGI::small("Leave blank to use the default port."), 379 ), 380 ); 381 print CGI::Tr( 382 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 383 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)), 384 ); 385 print CGI::Tr( 386 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 387 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)), 388 ); 389 print CGI::Tr( 390 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 391 CGI::td(CGI::textfield("add_sql_database", $add_sql_database, 25)), 392 ); 393 print CGI::Tr( 394 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 395 CGI::td( 396 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25), 397 CGI::br(), 398 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."), 399 ), 400 ); 401 print CGI::end_table(); 402 } elsif ($dbLayout eq "gdbm") { 403 print CGI::start_table({class=>"FormLayout"}); 404 print CGI::Tr( 405 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 406 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)), 407 ); 408 print CGI::end_table(); 409 } 410 411 print CGI::end_td(); 412 print CGI::end_Tr(); 413 print CGI::end_table(); 414 } 415 416 417 print CGI::p("To add an initial user to the new course, enter a user ID and password below. If you do not do so, you will not be able to log into the course."); 418 419 print CGI::table({class=>"FormLayout"}, 420 CGI::Tr( 421 CGI::th({class=>"LeftHeader"}, "Professor User ID:"), 422 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID || "professor", 25)), 423 ), 424 CGI::Tr( 425 CGI::th({class=>"LeftHeader"}, "Professor Password:"), 426 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 427 ), 428 ); 429 430 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 431 432 print CGI::end_form(); 433 } 434 435 sub add_course_validate { 436 my ($self) = @_; 437 my $r = $self->r; 438 my $ce = $r->ce; 439 #my $db = $r->db; 440 #my $authz = $r->authz; 441 #my $urlpath = $r->urlpath; 442 443 my $add_courseID = $r->param("add_courseID") || ""; 444 my $add_dbLayout = $r->param("add_dbLayout") || ""; 445 my $add_sql_host = $r->param("add_sql_host") || ""; 446 my $add_sql_port = $r->param("add_sql_port") || ""; 447 my $add_sql_username = $r->param("add_sql_username") || ""; 448 my $add_sql_password = $r->param("add_sql_password") || ""; 449 my $add_sql_database = $r->param("add_sql_database") || ""; 450 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 451 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 452 my $add_initial_userID = $r->param("add_initial_userID") || ""; 453 my $add_initial_password = $r->param("add_initial_password") || ""; 454 455 my @errors; 456 457 if ($add_courseID eq "") { 458 push @errors, "You must specify a course name."; 459 } 460 461 if ($add_dbLayout eq "") { 462 push @errors, "You must select a database layout."; 463 } else { 464 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 465 if ($add_dbLayout eq "sql") { 466 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 467 push @errors, "You must specify the SQL admin password." if $add_sql_password eq ""; 468 push @errors, "You must specify the SQL confirm_delete_course." if $add_sql_database eq ""; 469 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 470 } elsif ($add_dbLayout eq "gdbm") { 471 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 472 } 473 } else { 474 push @errors, "The database layout $add_dbLayout doesn't exist."; 475 } 476 } 477 478 if ($add_initial_userID ne "") { 479 push @errors, "You must specify a professor password." if $add_initial_password eq ""; 480 } 481 482 return @errors; 483 } 484 485 sub do_add_course { 486 my ($self) = @_; 487 my $r = $self->r; 488 my $ce = $r->ce; 489 my $db = $r->db; 490 #my $authz = $r->authz; 491 my $urlpath = $r->urlpath; 492 493 my $add_courseID = $r->param("add_courseID") || ""; 494 my $add_dbLayout = $r->param("add_dbLayout") || ""; 495 my $add_sql_host = $r->param("add_sql_host") || ""; 496 my $add_sql_port = $r->param("add_sql_port") || ""; 497 my $add_sql_username = $r->param("add_sql_username") || ""; 498 my $add_sql_password = $r->param("add_sql_password") || ""; 499 my $add_sql_database = $r->param("add_sql_database") || ""; 500 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 501 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 502 my $add_initial_userID = $r->param("add_initial_userID") || ""; 503 my $add_initial_password = $r->param("add_initial_password") || ""; 504 505 my $ce2 = WeBWorK::CourseEnvironment->new( 506 $ce->{webworkDirs}->{root}, 507 $ce->{webworkURLs}->{root}, 508 $ce->{pg}->{directories}->{root}, 509 $add_courseID, 510 ); 511 512 my %courseOptions = { dbLayoutName => $add_dbLayout }; 513 if ($add_dbLayout eq "gdbm") { 514 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 515 } 516 517 my %dbOptions; 518 if ($add_dbLayout eq "sql") { 519 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 520 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 521 $dbOptions{username} = $add_sql_username; 522 $dbOptions{password} = $add_sql_password; 523 $dbOptions{database} = $add_sql_database; 524 $dbOptions{wwhost} = $add_sql_wwhost; 525 } 526 527 my @users; 528 if ($add_initial_userID ne "") { 529 my $User = $db->newUser( 530 user_id => $add_initial_userID, 531 status => "C", 532 ); 533 my $Password = $db->newPassword( 534 user_id => $add_initial_userID, 535 password => cryptPassword($add_initial_password), 536 ); 537 my $PermissionLevel = $db->newPermissionLevel( 538 user_id => $add_initial_userID, 539 permission => "10", 540 ); 541 push @users, [ $User, $Password, $PermissionLevel ]; 542 } 543 544 eval { 545 addCourse( 546 courseID => $add_courseID, 547 ce => $ce2, 548 courseOptions => \%courseOptions, 549 dbOptions => \%dbOptions, 550 users => \@users, 551 ); 552 }; 553 554 if ($@) { 555 my $error = $@; 556 print CGI::div({class=>"ResultsWithError"}, 557 CGI::p("An error occured while creating the course $add_courseID:"), 558 CGI::tt(CGI::escapeHTML($error)), 559 ); 560 } else { 561 print CGI::div({class=>"ResultsWithoutError"}, 562 CGI::p("Successfully created the course $add_courseID"), 563 ); 564 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 565 courseID => $add_courseID); 566 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 567 print CGI::div({style=>"text-align: center"}, 568 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 569 ); 570 } 571 } 572 573 ################################################################################ 574 575 sub delete_course_form { 576 my ($self) = @_; 577 my $r = $self->r; 578 my $ce = $r->ce; 579 #my $db = $r->db; 580 #my $authz = $r->authz; 581 #my $urlpath = $r->urlpath; 582 583 my $delete_courseID = $r->param("delete_courseID") || ""; 584 my $delete_sql_host = $r->param("delete_sql_host") || ""; 585 my $delete_sql_port = $r->param("delete_sql_port") || ""; 586 my $delete_sql_username = $r->param("delete_sql_username") || ""; 587 my $delete_sql_password = $r->param("delete_sql_password") || ""; 588 my $delete_sql_database = $r->param("delete_sql_database") || ""; 589 590 my @courseIDs = listCourses($ce); 591 592 my %courseLabels; # records... heh. 593 foreach my $courseID (@courseIDs) { 594 my $tempCE = WeBWorK::CourseEnvironment->new( 595 $ce->{webworkDirs}->{root}, 596 $ce->{webworkURLs}->{root}, 597 $ce->{pg}->{directories}->{root}, 598 $courseID, 599 ); 600 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 601 } 602 603 print CGI::h2("Delete Course"); 604 605 print CGI::start_form("POST", $r->uri); 606 print $self->hidden_authen_fields; 607 print $self->hidden_fields("subDisplay"); 608 609 print CGI::p("Select a course to delete."); 610 611 print CGI::table({class=>"FormLayout"}, 612 CGI::Tr( 613 CGI::th({class=>"LeftHeader"}, "Course Name:"), 614 CGI::td( 615 CGI::scrolling_list( 616 -name => "delete_courseID", 617 -values => \@courseIDs, 618 -default => $delete_courseID, 619 -size => 10, 620 -multiple => 0, 621 -labels => \%courseLabels, 622 ), 623 ), 624 ), 625 ); 626 627 print CGI::p( 628 "If the course's database layout (indicated in parentheses above) is " 629 . CGI::b("sql") . ", supply the SQL connections information requested below." 630 ); 631 632 print CGI::start_table({class=>"FormLayout"}); 633 print CGI::Tr( 634 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 635 CGI::td( 636 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 637 CGI::br(), 638 CGI::small("Leave blank to use the default host."), 639 ), 640 ); 641 print CGI::Tr( 642 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 643 CGI::td( 644 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 645 CGI::br(), 646 CGI::small("Leave blank to use the default port."), 647 ), 648 ); 649 print CGI::Tr( 650 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 651 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 652 ); 653 print CGI::Tr( 654 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 655 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 656 ); 657 print CGI::Tr( 658 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 659 CGI::td(CGI::textfield("delete_sql_database", $delete_sql_database, 25)), 660 ); 661 print CGI::end_table(); 662 663 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 664 665 print CGI::end_form(); 666 } 667 668 sub delete_course_validate { 669 my ($self) = @_; 670 my $r = $self->r; 671 my $ce = $r->ce; 672 #my $db = $r->db; 673 #my $authz = $r->authz; 674 my $urlpath = $r->urlpath; 675 676 my $delete_courseID = $r->param("delete_courseID") || ""; 677 my $delete_sql_host = $r->param("delete_sql_host") || ""; 678 my $delete_sql_port = $r->param("delete_sql_port") || ""; 679 my $delete_sql_username = $r->param("delete_sql_username") || ""; 680 my $delete_sql_password = $r->param("delete_sql_password") || ""; 681 my $delete_sql_database = $r->param("delete_sql_database") || ""; 682 683 my @errors; 684 685 if ($delete_courseID eq "") { 686 push @errors, "You must specify a course name."; 687 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 688 push @errors, "You cannot delete the course you are currently using."; 689 } 690 691 my $ce2 = WeBWorK::CourseEnvironment->new( 692 $ce->{webworkDirs}->{root}, 693 $ce->{webworkURLs}->{root}, 694 $ce->{pg}->{directories}->{root}, 695 $delete_courseID, 696 ); 697 698 if ($ce2->{dbLayoutName} eq "sql") { 699 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 700 push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 701 push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 702 } 703 704 return @errors; 705 } 706 707 sub delete_course_confirm { 708 my ($self) = @_; 709 my $r = $self->r; 710 my $ce = $r->ce; 711 #my $db = $r->db; 712 #my $authz = $r->authz; 713 #my $urlpath = $r->urlpath; 714 715 print CGI::h2("Delete Course"); 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_database = $r->param("delete_sql_database") || ""; 721 722 my $ce2 = WeBWorK::CourseEnvironment->new( 723 $ce->{webworkDirs}->{root}, 724 $ce->{webworkURLs}->{root}, 725 $ce->{pg}->{directories}->{root}, 726 $delete_courseID, 727 ); 728 729 if ($ce2->{dbLayoutName} eq "sql") { 730 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 731 . "? All course files and data and the following database will be destroyed." 732 . " There is no undo available."); 733 734 print CGI::table({class=>"FormLayout"}, 735 CGI::Tr( 736 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 737 CGI::td($delete_sql_host || "system default"), 738 ), 739 CGI::Tr( 740 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 741 CGI::td($delete_sql_port || "system default"), 742 ), 743 CGI::Tr( 744 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 745 CGI::td($delete_sql_database), 746 ), 747 ); 748 } else { 749 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 750 . "? All course files and data will be destroyed. There is no undo available."); 751 } 752 753 print CGI::start_form("POST", $r->uri); 754 print $self->hidden_authen_fields; 755 print $self->hidden_fields("subDisplay"); 756 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 757 758 print CGI::p({style=>"text-align: center"}, 759 CGI::submit("decline_delete_course", "Don't delete"), 760 " ", 761 CGI::submit("confirm_delete_course", "Delete"), 762 ); 763 764 print CGI::end_form(); 765 } 766 767 sub do_delete_course { 768 my ($self) = @_; 769 my $r = $self->r; 770 my $ce = $r->ce; 771 #my $db = $r->db; 772 #my $authz = $r->authz; 773 #my $urlpath = $r->urlpath; 774 775 my $delete_courseID = $r->param("delete_courseID") || ""; 776 my $delete_sql_host = $r->param("delete_sql_host") || ""; 777 my $delete_sql_port = $r->param("delete_sql_port") || ""; 778 my $delete_sql_username = $r->param("delete_sql_username") || ""; 779 my $delete_sql_password = $r->param("delete_sql_password") || ""; 780 my $delete_sql_database = $r->param("delete_sql_database") || ""; 781 782 my $ce2 = WeBWorK::CourseEnvironment->new( 783 $ce->{webworkDirs}->{root}, 784 $ce->{webworkURLs}->{root}, 785 $ce->{pg}->{directories}->{root}, 786 $delete_courseID, 787 ); 788 789 my %dbOptions; 790 if ($ce2->{dbLayoutName} eq "sql") { 791 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 792 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 793 $dbOptions{username} = $delete_sql_username; 794 $dbOptions{password} = $delete_sql_password; 795 $dbOptions{database} = $delete_sql_database; 796 } 797 798 eval { 799 deleteCourse( 800 courseID => $delete_courseID, 801 ce => $ce2, 802 dbOptions => \%dbOptions, 803 ); 804 }; 805 806 if ($@) { 807 my $error = $@; 808 print CGI::div({class=>"ResultsWithError"}, 809 CGI::p("An error occured while deleting the course $delete_courseID:"), 810 CGI::tt(CGI::escapeHTML($error)), 811 ); 812 } else { 813 print CGI::div({class=>"ResultsWithoutError"}, 814 CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"), 815 ); 816 817 print CGI::start_form("POST", $r->uri); 818 print $self->hidden_authen_fields; 819 print $self->hidden_fields("subDisplay"); 820 821 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 822 823 print CGI::end_form(); 824 } 825 } 826 827 ################################################################################ 828 829 sub export_database_form { 830 my ($self) = @_; 831 my $r = $self->r; 832 my $ce = $r->ce; 833 #my $db = $r->db; 834 #my $authz = $r->authz; 835 #my $urlpath = $r->urlpath; 836 837 my @tables = keys %{$ce->{dbLayout}}; 838 839 my $export_courseID = $r->param("export_courseID") || ""; 840 my @export_tables = $r->param("export_tables"); 841 842 @export_tables = @tables unless @export_tables; 843 844 my @courseIDs = listCourses($ce); 845 846 my %courseLabels; # records... heh. 847 foreach my $courseID (@courseIDs) { 848 my $tempCE = WeBWorK::CourseEnvironment->new( 849 $ce->{webworkDirs}->{root}, 850 $ce->{webworkURLs}->{root}, 851 $ce->{pg}->{directories}->{root}, 852 $courseID, 853 ); 854 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 855 } 856 857 print CGI::h2("Export Database"); 858 859 print CGI::start_form("POST", $r->uri); 860 print $self->hidden_authen_fields; 861 print $self->hidden_fields("subDisplay"); 862 863 print CGI::p("Select a course to export the course's database."); 864 865 print CGI::table({class=>"FormLayout"}, 866 CGI::Tr( 867 CGI::th({class=>"LeftHeader"}, "Course Name:"), 868 CGI::td( 869 CGI::scrolling_list( 870 -name => "export_courseID", 871 -values => \@courseIDs, 872 -default => $export_courseID, 873 -size => 10, 874 -multiple => 0, 875 -labels => \%courseLabels, 876 ), 877 ), 878 ), 879 CGI::Tr( 880 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 881 CGI::td( 882 CGI::checkbox_group( 883 -name => "export_tables", 884 -values => \@tables, 885 -default => \@export_tables, 886 -linebreak => 1, 887 ), 888 ), 889 ), 890 ); 891 892 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 893 894 print CGI::end_form(); 895 } 896 897 sub export_database_validate { 898 my ($self) = @_; 899 my $r = $self->r; 900 #my $ce = $r->ce; 901 #my $db = $r->db; 902 #my $authz = $r->authz; 903 #my $urlpath = $r->urlpath; 904 905 my $export_courseID = $r->param("export_courseID") || ""; 906 my @export_tables = $r->param("export_tables"); 907 908 my @errors; 909 910 if ($export_courseID eq "") { 911 push @errors, "You must specify a course name."; 912 } 913 914 unless (@export_tables) { 915 push @errors, "You must specify at least one table to export."; 916 } 917 918 return @errors; 919 } 920 921 sub do_export_database { 922 my ($self) = @_; 923 my $r = $self->r; 924 my $ce = $r->ce; 925 #my $db = $r->db; 926 #my $authz = $r->authz; 927 my $urlpath = $r->urlpath; 928 929 my $export_courseID = $r->param("export_courseID"); 930 my @export_tables = $r->param("export_tables"); 931 932 my $ce2 = WeBWorK::CourseEnvironment->new( 933 $ce->{webworkDirs}->{root}, 934 $ce->{webworkURLs}->{root}, 935 $ce->{pg}->{directories}->{root}, 936 $export_courseID, 937 ); 938 939 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 940 941 my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 942 my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 943 944 my @errors; 945 946 eval { 947 @errors = dbExport( 948 db => $db2, 949 xml => $fh, 950 tables => \@export_tables, 951 ); 952 }; 953 954 push @errors, "Fatal exception: $@" if $@; 955 956 if (@errors) { 957 print CGI::div({class=>"ResultsWithError"}, 958 CGI::p("An error occured while exporting the database of course $export_courseID:"), 959 CGI::ul(CGI::li(\@errors)), 960 ); 961 } else { 962 print CGI::div({class=>"ResultsWithoutError"}, 963 CGI::p("Export succeeded."), 964 ); 965 966 print CGI::div({style=>"text-align: center"}, 967 CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 968 ); 969 } 970 } 971 972 ################################################################################ 973 974 sub import_database_form { 975 my ($self) = @_; 976 my $r = $self->r; 977 my $ce = $r->ce; 978 #my $db = $r->db; 979 #my $authz = $r->authz; 980 #my $urlpath = $r->urlpath; 981 982 my @tables = keys %{$ce->{dbLayout}}; 983 984 my $import_file = $r->param("import_file") || ""; 985 my $import_courseID = $r->param("import_courseID") || ""; 986 my @import_tables = $r->param("import_tables"); 987 my $import_conflict = $r->param("import_conflict") || "skip"; 988 989 @import_tables = @tables unless @import_tables; 990 991 my @courseIDs = listCourses($ce); 992 993 my %courseLabels; # records... heh. 994 foreach my $courseID (@courseIDs) { 995 my $tempCE = WeBWorK::CourseEnvironment->new( 996 $ce->{webworkDirs}->{root}, 997 $ce->{webworkURLs}->{root}, 998 $ce->{pg}->{directories}->{root}, 999 $courseID, 1000 ); 1001 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1002 } 1003 1004 print CGI::h2("Import Database"); 1005 1006 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1007 print $self->hidden_authen_fields; 1008 print $self->hidden_fields("subDisplay"); 1009 1010 print CGI::table({class=>"FormLayout"}, 1011 CGI::Tr( 1012 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1013 CGI::td( 1014 CGI::filefield( 1015 -name => "import_file", 1016 -size => 50, 1017 ), 1018 ), 1019 ), 1020 CGI::Tr( 1021 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1022 CGI::td( 1023 CGI::checkbox_group( 1024 -name => "import_tables", 1025 -values => \@tables, 1026 -default => \@import_tables, 1027 -linebreak => 1, 1028 ), 1029 ), 1030 ), 1031 CGI::Tr( 1032 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1033 CGI::td( 1034 CGI::scrolling_list( 1035 -name => "import_courseID", 1036 -values => \@courseIDs, 1037 -default => $import_courseID, 1038 -size => 10, 1039 -multiple => 0, 1040 -labels => \%courseLabels, 1041 ), 1042 ), 1043 ), 1044 CGI::Tr( 1045 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1046 CGI::td( 1047 CGI::radio_group( 1048 -name => "import_conflict", 1049 -values => [qw/skip replace/], 1050 -default => $import_conflict, 1051 -linebreak=>'true', 1052 -labels => { 1053 skip => "Skip duplicate records", 1054 replace => "Replace duplicate records", 1055 }, 1056 ), 1057 ), 1058 ), 1059 ); 1060 1061 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1062 1063 print CGI::end_form(); 1064 } 1065 1066 sub import_database_validate { 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 $import_file = $r->param("import_file") || ""; 1075 my $import_courseID = $r->param("import_courseID") || ""; 1076 my @import_tables = $r->param("import_tables"); 1077 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1078 1079 my @errors; 1080 1081 if ($import_file eq "") { 1082 push @errors, "You must specify a database file to upload."; 1083 } 1084 1085 if ($import_courseID eq "") { 1086 push @errors, "You must specify a course name."; 1087 } 1088 1089 unless (@import_tables) { 1090 push @errors, "You must specify at least one table to import."; 1091 } 1092 1093 return @errors; 1094 } 1095 1096 sub do_import_database { 1097 my ($self) = @_; 1098 my $r = $self->r; 1099 my $ce = $r->ce; 1100 #my $db = $r->db; 1101 #my $authz = $r->authz; 1102 my $urlpath = $r->urlpath; 1103 1104 my $import_file = $r->param("import_file"); 1105 my $import_courseID = $r->param("import_courseID"); 1106 my @import_tables = $r->param("import_tables"); 1107 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1108 1109 my $ce2 = WeBWorK::CourseEnvironment->new( 1110 $ce->{webworkDirs}->{root}, 1111 $ce->{webworkURLs}->{root}, 1112 $ce->{pg}->{directories}->{root}, 1113 $import_courseID, 1114 ); 1115 1116 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1117 1118 # retrieve upload from upload cache 1119 my ($id, $hash) = split /\s+/, $import_file; 1120 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1121 dir => $ce->{webworkDirs}->{uploadCache} 1122 ); 1123 1124 my @errors; 1125 1126 eval { 1127 @errors = dbImport( 1128 db => $db2, 1129 xml => $upload->fileHandle, 1130 tables => \@import_tables, 1131 conflict => $import_conflict, 1132 ); 1133 }; 1134 1135 $upload->dispose; 1136 1137 push @errors, "Fatal exception: $@" if $@; 1138 1139 if (@errors) { 1140 print CGI::div({class=>"ResultsWithError"}, 1141 CGI::p("An error occured while importing the database of course $import_courseID:"), 1142 CGI::ul(CGI::li(\@errors)), 1143 ); 1144 } else { 1145 print CGI::div({class=>"ResultsWithoutError"}, 1146 CGI::p("Import succeeded."), 1147 ); 1148 } 1149 } 1150 1151 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |