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