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