Parent Directory
| 
Revision Log
implemented import and export, fixed some bugs
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.2 2004/04/09 20:19:25 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 @{ $sources{$curr} } > @{ $sources{$source} }; 299 } 300 } else { 301 ($source) = keys %sources; 302 } 303 $source; 304 }; 305 306 print CGI::h2("Add Course"); 307 308 print CGI::start_form("POST", $r->uri); 309 print $self->hidden_authen_fields; 310 print $self->hidden_fields("subDisplay"); 311 312 print CGI::p("Specify a name for the new course."); 313 314 print CGI::table({class=>"FormLayout"}, 315 CGI::Tr( 316 CGI::th({class=>"LeftHeader"}, "Course Name:"), 317 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 318 ), 319 ); 320 321 print CGI::p("Select a database layout below. Some database layouts require additional information."); 322 323 #print CGI::start_Tr(); 324 #print CGI::th({class=>"LeftHeader"}, "Database Layout:"); 325 #print CGI::start_td(); 326 327 foreach my $dbLayout (@dbLayouts) { 328 print CGI::start_table({class=>"FormLayout"}); 329 330 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 331 print CGI::Tr( 332 CGI::td({style=>"text-align: right"}, 333 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 334 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 335 ), 336 CGI::td($dbLayout), 337 ); 338 339 print CGI::start_Tr(); 340 print CGI::td(); # for indentation :( 341 print CGI::start_td(); 342 343 if ($dbLayout eq "sql") { 344 print CGI::p( 345 "The SQL settings you enter below must match the settings in the DBI source", 346 " specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"), 347 " with the course name you entered above." 348 ); 349 print CGI::start_table({class=>"FormLayout"}); 350 print CGI::Tr( 351 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 352 CGI::td( 353 CGI::textfield("add_sql_host", $add_sql_host, 25), 354 CGI::br(), 355 CGI::small("Leave blank to use the default host."), 356 ), 357 ); 358 print CGI::Tr( 359 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 360 CGI::td( 361 CGI::textfield("add_sql_port", $add_sql_port, 25), 362 CGI::br(), 363 CGI::small("Leave blank to use the default port."), 364 ), 365 ); 366 print CGI::Tr( 367 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 368 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)), 369 ); 370 print CGI::Tr( 371 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 372 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)), 373 ); 374 print CGI::Tr( 375 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 376 CGI::td(CGI::textfield("add_sql_database", $add_sql_database, 25)), 377 ); 378 print CGI::Tr( 379 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 380 CGI::td( 381 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25), 382 CGI::br(), 383 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."), 384 ), 385 ); 386 print CGI::end_table(); 387 } elsif ($dbLayout eq "gdbm") { 388 print CGI::start_table({class=>"FormLayout"}); 389 print CGI::Tr( 390 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 391 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "professor", 25)), 392 ); 393 print CGI::end_table(); 394 } 395 396 print CGI::end_td(); 397 print CGI::end_Tr(); 398 print CGI::end_table(); 399 } 400 401 402 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."); 403 404 print CGI::table({class=>"FormLayout"}, 405 CGI::Tr( 406 CGI::th({class=>"LeftHeader"}, "Professor User ID:"), 407 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID || "professor", 25)), 408 ), 409 CGI::Tr( 410 CGI::th({class=>"LeftHeader"}, "Professor Password:"), 411 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 412 ), 413 ); 414 415 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 416 417 print CGI::end_form(); 418 } 419 420 sub add_course_validate { 421 my ($self) = @_; 422 my $r = $self->r; 423 my $ce = $r->ce; 424 #my $db = $r->db; 425 #my $authz = $r->authz; 426 #my $urlpath = $r->urlpath; 427 428 my $add_courseID = $r->param("add_courseID") || ""; 429 my $add_dbLayout = $r->param("add_dbLayout") || ""; 430 my $add_sql_host = $r->param("add_sql_host") || ""; 431 my $add_sql_port = $r->param("add_sql_port") || ""; 432 my $add_sql_username = $r->param("add_sql_username") || ""; 433 my $add_sql_password = $r->param("add_sql_password") || ""; 434 my $add_sql_database = $r->param("add_sql_database") || ""; 435 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 436 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 437 my $add_initial_userID = $r->param("add_initial_userID") || ""; 438 my $add_initial_password = $r->param("add_initial_password") || ""; 439 440 my @errors; 441 442 if ($add_courseID eq "") { 443 push @errors, "You must specify a course name."; 444 } 445 446 if ($add_dbLayout eq "") { 447 push @errors, "You must select a database layout."; 448 } else { 449 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 450 if ($add_dbLayout eq "sql") { 451 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 452 push @errors, "You must specify the SQL admin password." if $add_sql_password eq ""; 453 push @errors, "You must specify the SQL confirm_delete_course." if $add_sql_database eq ""; 454 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 455 } elsif ($add_dbLayout eq "gdbm") { 456 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 457 } 458 } else { 459 push @errors, "The database layout $add_dbLayout doesn't exist."; 460 } 461 } 462 463 if ($add_initial_userID ne "") { 464 push @errors, "You must specify a professor password." if $add_initial_password eq ""; 465 } 466 467 return @errors; 468 } 469 470 sub do_add_course { 471 my ($self) = @_; 472 my $r = $self->r; 473 my $ce = $r->ce; 474 my $db = $r->db; 475 #my $authz = $r->authz; 476 my $urlpath = $r->urlpath; 477 478 my $add_courseID = $r->param("add_courseID") || ""; 479 my $add_dbLayout = $r->param("add_dbLayout") || ""; 480 my $add_sql_host = $r->param("add_sql_host") || ""; 481 my $add_sql_port = $r->param("add_sql_port") || ""; 482 my $add_sql_username = $r->param("add_sql_username") || ""; 483 my $add_sql_password = $r->param("add_sql_password") || ""; 484 my $add_sql_database = $r->param("add_sql_database") || ""; 485 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 486 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 487 my $add_initial_userID = $r->param("add_initial_userID") || ""; 488 my $add_initial_password = $r->param("add_initial_password") || ""; 489 490 my $ce2 = WeBWorK::CourseEnvironment->new( 491 $ce->{webworkDirs}->{root}, 492 $ce->{webworkURLs}->{root}, 493 $ce->{pg}->{directories}->{root}, 494 $add_courseID, 495 ); 496 497 my %dbOptions; 498 if ($add_dbLayout eq "sql") { 499 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 500 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 501 $dbOptions{username} = $add_sql_username; 502 $dbOptions{password} = $add_sql_password; 503 $dbOptions{database} = $add_sql_database; 504 $dbOptions{wwhost} = $add_sql_wwhost; 505 } 506 507 my @users; 508 if ($add_initial_userID ne "") { 509 my $User = $db->newUser( 510 user_id => $add_initial_userID, 511 status => "C", 512 ); 513 my $Password = $db->newPassword( 514 user_id => $add_initial_userID, 515 password => cryptPassword($add_initial_password), 516 ); 517 my $PermissionLevel = $db->newPermissionLevel( 518 user_id => $add_initial_userID, 519 permission => "10", 520 ); 521 push @users, [ $User, $Password, $PermissionLevel ]; 522 } 523 524 eval { 525 addCourse( 526 courseID => $add_courseID, 527 ce => $ce2, 528 courseOptions => { dbLayoutName => $add_dbLayout }, 529 dbOptions => \%dbOptions, 530 users => \@users, 531 ); 532 }; 533 534 if ($@) { 535 my $error = $@; 536 print CGI::div({class=>"ResultsWithError"}, 537 CGI::p("An error occured while creating the course $add_courseID:"), 538 CGI::tt(CGI::escapeHTML($error)), 539 ); 540 } else { 541 print CGI::div({class=>"ResultsWithoutError"}, 542 CGI::p("Successfully created the course $add_courseID"), 543 ); 544 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 545 courseID => $add_courseID); 546 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 547 print CGI::div({style=>"text-align: center"}, 548 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 549 ); 550 } 551 } 552 553 ################################################################################ 554 555 sub delete_course_form { 556 my ($self) = @_; 557 my $r = $self->r; 558 my $ce = $r->ce; 559 #my $db = $r->db; 560 #my $authz = $r->authz; 561 #my $urlpath = $r->urlpath; 562 563 my $delete_courseID = $r->param("delete_courseID") || ""; 564 my $delete_sql_host = $r->param("delete_sql_host") || ""; 565 my $delete_sql_port = $r->param("delete_sql_port") || ""; 566 my $delete_sql_username = $r->param("delete_sql_username") || ""; 567 my $delete_sql_password = $r->param("delete_sql_password") || ""; 568 my $delete_sql_database = $r->param("delete_sql_database") || ""; 569 570 my @courseIDs = listCourses($ce); 571 572 my %courseLabels; # records... heh. 573 foreach my $courseID (@courseIDs) { 574 my $tempCE = WeBWorK::CourseEnvironment->new( 575 $ce->{webworkDirs}->{root}, 576 $ce->{webworkURLs}->{root}, 577 $ce->{pg}->{directories}->{root}, 578 $courseID, 579 ); 580 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 581 } 582 583 print CGI::h2("Delete Course"); 584 585 print CGI::start_form("POST", $r->uri); 586 print $self->hidden_authen_fields; 587 print $self->hidden_fields("subDisplay"); 588 589 print CGI::p("Select a course to delete."); 590 591 print CGI::table({class=>"FormLayout"}, 592 CGI::Tr( 593 CGI::th({class=>"LeftHeader"}, "Course Name:"), 594 CGI::td( 595 CGI::scrolling_list( 596 -name => "delete_courseID", 597 -values => \@courseIDs, 598 -default => $delete_courseID, 599 -size => 10, 600 -multiple => 0, 601 -labels => \%courseLabels, 602 ), 603 ), 604 ), 605 ); 606 607 print CGI::p( 608 "If the course's database layout (indicated in parentheses above) is " 609 . CGI::b("sql") . ", supply the SQL connections information requested below." 610 ); 611 612 print CGI::start_table({class=>"FormLayout"}); 613 print CGI::Tr( 614 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 615 CGI::td( 616 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 617 CGI::br(), 618 CGI::small("Leave blank to use the default host."), 619 ), 620 ); 621 print CGI::Tr( 622 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 623 CGI::td( 624 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 625 CGI::br(), 626 CGI::small("Leave blank to use the default port."), 627 ), 628 ); 629 print CGI::Tr( 630 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 631 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 632 ); 633 print CGI::Tr( 634 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 635 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 636 ); 637 print CGI::Tr( 638 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 639 CGI::td(CGI::textfield("delete_sql_database", $delete_sql_database, 25)), 640 ); 641 print CGI::end_table(); 642 643 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 644 645 print CGI::end_form(); 646 } 647 648 sub delete_course_validate { 649 my ($self) = @_; 650 my $r = $self->r; 651 my $ce = $r->ce; 652 #my $db = $r->db; 653 #my $authz = $r->authz; 654 my $urlpath = $r->urlpath; 655 656 my $delete_courseID = $r->param("delete_courseID") || ""; 657 my $delete_sql_host = $r->param("delete_sql_host") || ""; 658 my $delete_sql_port = $r->param("delete_sql_port") || ""; 659 my $delete_sql_username = $r->param("delete_sql_username") || ""; 660 my $delete_sql_password = $r->param("delete_sql_password") || ""; 661 my $delete_sql_database = $r->param("delete_sql_database") || ""; 662 663 my @errors; 664 665 if ($delete_courseID eq "") { 666 push @errors, "You must specify a course name."; 667 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 668 push @errors, "You cannot delete the course you are currently using."; 669 } 670 671 my $ce2 = WeBWorK::CourseEnvironment->new( 672 $ce->{webworkDirs}->{root}, 673 $ce->{webworkURLs}->{root}, 674 $ce->{pg}->{directories}->{root}, 675 $delete_courseID, 676 ); 677 678 if ($ce2->{dbLayoutName} eq "sql") { 679 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 680 push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 681 push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 682 } 683 684 return @errors; 685 } 686 687 sub delete_course_confirm { 688 my ($self) = @_; 689 my $r = $self->r; 690 my $ce = $r->ce; 691 #my $db = $r->db; 692 #my $authz = $r->authz; 693 #my $urlpath = $r->urlpath; 694 695 print CGI::h2("Delete Course"); 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_database = $r->param("delete_sql_database") || ""; 701 702 my $ce2 = WeBWorK::CourseEnvironment->new( 703 $ce->{webworkDirs}->{root}, 704 $ce->{webworkURLs}->{root}, 705 $ce->{pg}->{directories}->{root}, 706 $delete_courseID, 707 ); 708 709 if ($ce2->{dbLayoutName} eq "sql") { 710 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 711 . "? All course files and data and the following database will be destroyed." 712 . " There is no undo available."); 713 714 print CGI::table({class=>"FormLayout"}, 715 CGI::Tr( 716 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 717 CGI::td($delete_sql_host || "system default"), 718 ), 719 CGI::Tr( 720 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 721 CGI::td($delete_sql_port || "system default"), 722 ), 723 CGI::Tr( 724 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 725 CGI::td($delete_sql_database), 726 ), 727 ); 728 } else { 729 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 730 . "? All course files and data will be destroyed. There is no undo available."); 731 } 732 733 print CGI::start_form("POST", $r->uri); 734 print $self->hidden_authen_fields; 735 print $self->hidden_fields("subDisplay"); 736 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 737 738 print CGI::p({style=>"text-align: center"}, 739 CGI::submit("decline_delete_course", "Don't delete"), 740 " ", 741 CGI::submit("confirm_delete_course", "Delete"), 742 ); 743 744 print CGI::end_form(); 745 } 746 747 sub do_delete_course { 748 my ($self) = @_; 749 my $r = $self->r; 750 my $ce = $r->ce; 751 #my $db = $r->db; 752 #my $authz = $r->authz; 753 #my $urlpath = $r->urlpath; 754 755 my $delete_courseID = $r->param("delete_courseID") || ""; 756 my $delete_sql_host = $r->param("delete_sql_host") || ""; 757 my $delete_sql_port = $r->param("delete_sql_port") || ""; 758 my $delete_sql_username = $r->param("delete_sql_username") || ""; 759 my $delete_sql_password = $r->param("delete_sql_password") || ""; 760 my $delete_sql_database = $r->param("delete_sql_database") || ""; 761 762 my $ce2 = WeBWorK::CourseEnvironment->new( 763 $ce->{webworkDirs}->{root}, 764 $ce->{webworkURLs}->{root}, 765 $ce->{pg}->{directories}->{root}, 766 $delete_courseID, 767 ); 768 769 my %dbOptions; 770 if ($ce2->{dbLayoutName} eq "sql") { 771 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 772 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 773 $dbOptions{username} = $delete_sql_username; 774 $dbOptions{password} = $delete_sql_password; 775 $dbOptions{database} = $delete_sql_database; 776 } 777 778 eval { 779 deleteCourse( 780 courseID => $delete_courseID, 781 ce => $ce2, 782 dbOptions => \%dbOptions, 783 ); 784 }; 785 786 if ($@) { 787 my $error = $@; 788 print CGI::div({class=>"ResultsWithError"}, 789 CGI::p("An error occured while deleting the course $delete_courseID:"), 790 CGI::tt(CGI::escapeHTML($error)), 791 ); 792 } else { 793 print CGI::div({class=>"ResultsWithoutError"}, 794 CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"), 795 ); 796 797 print CGI::start_form("POST", $r->uri); 798 print $self->hidden_authen_fields; 799 print $self->hidden_fields("subDisplay"); 800 801 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 802 803 print CGI::end_form(); 804 } 805 } 806 807 ################################################################################ 808 809 sub export_database_form { 810 my ($self) = @_; 811 my $r = $self->r; 812 my $ce = $r->ce; 813 #my $db = $r->db; 814 #my $authz = $r->authz; 815 #my $urlpath = $r->urlpath; 816 817 my @tables = keys %{$ce->{dbLayout}}; 818 819 my $export_courseID = $r->param("export_courseID") || ""; 820 my @export_tables = $r->param("export_tables"); 821 822 @export_tables = @tables unless @export_tables; 823 824 my @courseIDs = listCourses($ce); 825 826 my %courseLabels; # records... heh. 827 foreach my $courseID (@courseIDs) { 828 my $tempCE = WeBWorK::CourseEnvironment->new( 829 $ce->{webworkDirs}->{root}, 830 $ce->{webworkURLs}->{root}, 831 $ce->{pg}->{directories}->{root}, 832 $courseID, 833 ); 834 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 835 } 836 837 print CGI::h2("Export Database"); 838 839 print CGI::start_form("POST", $r->uri); 840 print $self->hidden_authen_fields; 841 print $self->hidden_fields("subDisplay"); 842 843 print CGI::p("Select a course to export the course's database."); 844 845 print CGI::table({class=>"FormLayout"}, 846 CGI::Tr( 847 CGI::th({class=>"LeftHeader"}, "Course Name:"), 848 CGI::td( 849 CGI::scrolling_list( 850 -name => "export_courseID", 851 -values => \@courseIDs, 852 -default => $export_courseID, 853 -size => 10, 854 -multiple => 0, 855 -labels => \%courseLabels, 856 ), 857 ), 858 ), 859 CGI::Tr( 860 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 861 CGI::td( 862 CGI::checkbox_group( 863 -name => "export_tables", 864 -values => \@tables, 865 -default => \@export_tables, 866 -linebreak => 1, 867 ), 868 ), 869 ), 870 ); 871 872 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 873 874 print CGI::end_form(); 875 } 876 877 sub export_database_validate { 878 my ($self) = @_; 879 my $r = $self->r; 880 #my $ce = $r->ce; 881 #my $db = $r->db; 882 #my $authz = $r->authz; 883 #my $urlpath = $r->urlpath; 884 885 my $export_courseID = $r->param("export_courseID") || ""; 886 my @export_tables = $r->param("export_tables"); 887 888 my @errors; 889 890 if ($export_courseID eq "") { 891 push @errors, "You must specify a course name."; 892 } 893 894 unless (@export_tables) { 895 push @errors, "You must specify at least one table to export."; 896 } 897 898 return @errors; 899 } 900 901 sub do_export_database { 902 my ($self) = @_; 903 my $r = $self->r; 904 my $ce = $r->ce; 905 #my $db = $r->db; 906 #my $authz = $r->authz; 907 my $urlpath = $r->urlpath; 908 909 my $export_courseID = $r->param("export_courseID"); 910 my @export_tables = $r->param("export_tables"); 911 912 my $ce2 = WeBWorK::CourseEnvironment->new( 913 $ce->{webworkDirs}->{root}, 914 $ce->{webworkURLs}->{root}, 915 $ce->{pg}->{directories}->{root}, 916 $export_courseID, 917 ); 918 919 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 920 921 my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 922 my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 923 924 my @errors; 925 926 eval { 927 @errors = dbExport( 928 db => $db2, 929 xml => $fh, 930 tables => \@export_tables, 931 ); 932 }; 933 934 push @errors, "Fatal exception: $@" if $@; 935 936 if (@errors) { 937 print CGI::div({class=>"ResultsWithError"}, 938 CGI::p("An error occured while exporting the database of course $export_courseID:"), 939 CGI::ul(CGI::li(\@errors)), 940 ); 941 } else { 942 print CGI::div({class=>"ResultsWithoutError"}, 943 CGI::p("Export succeeded."), 944 ); 945 946 print CGI::div({style=>"text-align: center"}, 947 CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 948 ); 949 } 950 } 951 952 ################################################################################ 953 954 sub import_database_form { 955 my ($self) = @_; 956 my $r = $self->r; 957 my $ce = $r->ce; 958 #my $db = $r->db; 959 #my $authz = $r->authz; 960 #my $urlpath = $r->urlpath; 961 962 my @tables = keys %{$ce->{dbLayout}}; 963 964 my $import_file = $r->param("import_file") || ""; 965 my $import_courseID = $r->param("import_courseID") || ""; 966 my @import_tables = $r->param("import_tables"); 967 my $import_conflict = $r->param("import_conflict") || "skip"; 968 969 @import_tables = @tables unless @import_tables; 970 971 my @courseIDs = listCourses($ce); 972 973 my %courseLabels; # records... heh. 974 foreach my $courseID (@courseIDs) { 975 my $tempCE = WeBWorK::CourseEnvironment->new( 976 $ce->{webworkDirs}->{root}, 977 $ce->{webworkURLs}->{root}, 978 $ce->{pg}->{directories}->{root}, 979 $courseID, 980 ); 981 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 982 } 983 984 print CGI::h2("Import Database"); 985 986 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 987 print $self->hidden_authen_fields; 988 print $self->hidden_fields("subDisplay"); 989 990 print CGI::table({class=>"FormLayout"}, 991 CGI::Tr( 992 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 993 CGI::td( 994 CGI::filefield( 995 -name => "import_file", 996 -size => 50, 997 ), 998 ), 999 ), 1000 CGI::Tr( 1001 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1002 CGI::td( 1003 CGI::checkbox_group( 1004 -name => "import_tables", 1005 -values => \@tables, 1006 -default => \@import_tables, 1007 -linebreak => 1, 1008 ), 1009 ), 1010 ), 1011 CGI::Tr( 1012 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1013 CGI::td( 1014 CGI::scrolling_list( 1015 -name => "import_courseID", 1016 -values => \@courseIDs, 1017 -default => $import_courseID, 1018 -size => 10, 1019 -multiple => 0, 1020 -labels => \%courseLabels, 1021 ), 1022 ), 1023 ), 1024 CGI::Tr( 1025 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1026 CGI::td( 1027 CGI::radio_group( 1028 -name => "import_conflict", 1029 -values => [qw/skip replace/], 1030 -default => $import_conflict, 1031 -linebreak=>'true', 1032 -labels => { 1033 skip => "Skip duplicate records", 1034 replace => "Replace duplicate records", 1035 }, 1036 ), 1037 ), 1038 ), 1039 ); 1040 1041 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1042 1043 print CGI::end_form(); 1044 } 1045 1046 sub import_database_validate { 1047 my ($self) = @_; 1048 my $r = $self->r; 1049 #my $ce = $r->ce; 1050 #my $db = $r->db; 1051 #my $authz = $r->authz; 1052 #my $urlpath = $r->urlpath; 1053 1054 my $import_file = $r->param("import_file") || ""; 1055 my $import_courseID = $r->param("import_courseID") || ""; 1056 my @import_tables = $r->param("import_tables"); 1057 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1058 1059 my @errors; 1060 1061 if ($import_file eq "") { 1062 push @errors, "You must specify a database file to upload."; 1063 } 1064 1065 if ($import_courseID eq "") { 1066 push @errors, "You must specify a course name."; 1067 } 1068 1069 unless (@import_tables) { 1070 push @errors, "You must specify at least one table to import."; 1071 } 1072 1073 return @errors; 1074 } 1075 1076 sub do_import_database { 1077 my ($self) = @_; 1078 my $r = $self->r; 1079 my $ce = $r->ce; 1080 #my $db = $r->db; 1081 #my $authz = $r->authz; 1082 my $urlpath = $r->urlpath; 1083 1084 my $import_file = $r->param("import_file"); 1085 my $import_courseID = $r->param("import_courseID"); 1086 my @import_tables = $r->param("import_tables"); 1087 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1088 1089 my $ce2 = WeBWorK::CourseEnvironment->new( 1090 $ce->{webworkDirs}->{root}, 1091 $ce->{webworkURLs}->{root}, 1092 $ce->{pg}->{directories}->{root}, 1093 $import_courseID, 1094 ); 1095 1096 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1097 1098 # retrieve upload from upload cache 1099 my ($id, $hash) = split /\s+/, $import_file; 1100 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1101 dir => $ce->{webworkDirs}->{uploadCache} 1102 ); 1103 1104 my @errors; 1105 1106 eval { 1107 @errors = dbImport( 1108 db => $db2, 1109 xml => $upload->fileHandle, 1110 tables => \@import_tables, 1111 conflict => $import_conflict, 1112 ); 1113 }; 1114 1115 $upload->dispose; 1116 1117 push @errors, "Fatal exception: $@" if $@; 1118 1119 if (@errors) { 1120 print CGI::div({class=>"ResultsWithError"}, 1121 CGI::p("An error occured while importing the database of course $import_courseID:"), 1122 CGI::ul(CGI::li(\@errors)), 1123 ); 1124 } else { 1125 print CGI::div({class=>"ResultsWithoutError"}, 1126 CGI::p("Import succeeded."), 1127 ); 1128 } 1129 } 1130 1131 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |