Parent Directory
| 
Revision Log
Added comments -- should we enter the contact person as a student in the admin class so that we can use the email facility to contact people hosted on this server?
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.14 2004/06/02 18:21:38 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::CourseAdmin; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI::Pretty qw(); 29 use Data::Dumper; 30 use File::Temp qw/tempfile/; 31 use WeBWorK::CourseEnvironment; 32 use WeBWorK::Utils qw(cryptPassword writeLog); 33 use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses); 34 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 35 36 sub pre_header_initialize { 37 my ($self) = @_; 38 my $r = $self->r; 39 my $ce = $r->ce; 40 my $db = $r->db; 41 my $authz = $r->authz; 42 my $urlpath = $r->urlpath; 43 my $user = $r->param('user'); 44 45 # check permissions 46 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 47 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 48 return; 49 } 50 51 if (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 my $add_initial_password_confirm = $r->param("add_initial_password_confirm") || ""; 211 my $add_feedback_email = $r->param("add_feedback_email") || ""; 212 my $add_templates_course = $r->param("add_templates_course") || ""; 213 my $add_contact_person = $r->param("add_contact_person") || ""; 214 my $add_contact_institution = $r->param("add_contact_institution") || ""; 215 my $add_course_title = $r->param("add_course_title") || ""; 216 my $add_contact_email = $r->param("add_contact_email") || ""; 217 my $add_admin_userID = $r->param("add_admin_userID") || $r->param("user") || ""; 218 my $add_admin_password = $r->param("add_admin_password") || ""; 219 220 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 221 222 my $ce2 = WeBWorK::CourseEnvironment->new( 223 $ce->{webworkDirs}->{root}, 224 $ce->{webworkURLs}->{root}, 225 $ce->{pg}->{directories}->{root}, 226 "COURSENAME", 227 ); 228 229 my $dbi_source = do { 230 # find the most common SQL source (stolen from CourseManagement.pm) 231 my %sources; 232 foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) { 233 $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++; 234 } 235 my $source; 236 if (keys %sources > 1) { 237 foreach my $curr (keys %sources) { 238 $source = $curr if not defined $source or 239 $sources{$curr} > $sources{$source}; 240 } 241 } else { 242 ($source) = keys %sources; 243 } 244 $source; 245 }; 246 247 my @existingCourses = listCourses($ce); 248 249 print CGI::h2("Add Course"); 250 251 print CGI::start_form("POST", $r->uri); 252 print $self->hidden_authen_fields; 253 print $self->hidden_fields("subDisplay"); 254 255 print CGI::p("Specify a name for the new course."); 256 257 print CGI::table({class=>"FormLayout"}, 258 CGI::Tr( 259 CGI::th({class=>"LeftHeader"}, "Course ID:"), 260 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 261 CGI::th({class=>"LeftHeader"}, "Course Title"), 262 CGI::td(CGI::textfield("add_course_title", $add_course_title, 25)), 263 ), 264 ); 265 266 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."); 267 268 print CGI::table({class=>"FormLayout"}, 269 CGI::Tr( 270 CGI::th({class=>"CenterHeader"}, "Instructor ID"), 271 CGI::th({class=>"CenterHeader"}, "Instructor Password"), 272 CGI::th({class=>"CenterHeader"}, "Confirm Instructor Password"), 273 274 275 ), 276 CGI::Tr( 277 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID || "professor", 25)), 278 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 279 CGI::td(CGI::password_field("add_initial_password_confirm", $add_initial_password_confirm, 25)), 280 281 ), 282 283 CGI::Tr( 284 CGI::th({class=>"CenterHeader"}, "Contact name"), 285 CGI::th({class=>"CenterHeader"}, "Contact institution"), 286 CGI::th({class=>"CenterHeader"}, "Contact e-mail"), 287 ), 288 CGI::Tr( 289 CGI::td(CGI::textfield("add_contact_person", $add_contact_person, 35)), 290 CGI::td(CGI::textfield("add_contact_institution", $add_contact_institution, 35)), 291 CGI::td(CGI::textfield("add_contact_email", $add_contact_email, 35)), 292 ), 293 CGI::Tr( 294 CGI::th({class=>"CenterHeader"}, "Administrator ID"), 295 CGI::th({class=>"CenterHeader"}, "Administrator Password"), 296 CGI::th({class=>"CenterHeader"}, "Feedback e-mail"), 297 298 ), 299 CGI::Tr( 300 CGI::td(CGI::textfield("add_admin_userID", $add_admin_userID, 25)), 301 CGI::td(CGI::password_field("add_admin_password", $add_admin_password, 25)), 302 CGI::td(CGI::textfield("add_feedback_email", $add_feedback_email, 25)), 303 ), 304 ); 305 306 print CGI::p("Select an existing course from which to copy templates:"); 307 308 print CGI::table({class=>"FormLayout"}, 309 CGI::Tr( 310 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 311 CGI::td( 312 CGI::popup_menu( 313 -name => "add_templates_course", 314 -values => [ "", @existingCourses ], 315 -default => $add_templates_course, 316 #-size => 10, 317 #-multiple => 0, 318 #-labels => \%courseLabels, 319 ), 320 321 ), 322 ), 323 ); 324 325 print CGI::p("Select a database layout below. Some database layouts require additional information."); 326 327 #print CGI::start_Tr(); 328 #print CGI::th({class=>"LeftHeader"}, "Database Layout:"); 329 #print CGI::start_td(); 330 331 foreach my $dbLayout (@dbLayouts) { 332 print CGI::start_table({class=>"FormLayout"}); 333 334 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 335 print CGI::Tr( 336 CGI::td({style=>"text-align: right"}, 337 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 338 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 339 ), 340 CGI::td($dbLayout), 341 ); 342 343 print CGI::start_Tr(); 344 print CGI::td(); # for indentation :( 345 print CGI::start_td(); 346 347 if ($dbLayout eq "sql") { 348 349 print CGI::start_table({class=>"FormLayout"}); 350 print CGI::Tr(CGI::td({colspan=>2}, 351 "The SQL Admin is a user in the SQL database with sufficient permissions to create a new database." 352 ) 353 ); 354 print CGI::Tr( 355 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 356 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)), 357 ); 358 print CGI::Tr( 359 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 360 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)), 361 ); 362 363 print CGI::Tr(CGI::td({colspan=>2}, CGI::hr(), 364 "The optionial SQL settings you enter below must match the settings in the DBI source", 365 " specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"), 366 " with the course name you entered above." 367 ) 368 ); 369 print CGI::Tr( 370 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 371 CGI::td( 372 CGI::textfield("add_sql_host", $add_sql_host, 25), 373 CGI::br(), 374 CGI::small("Leave blank to use the default host."), 375 ), 376 ); 377 print CGI::Tr( 378 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 379 CGI::td( 380 CGI::textfield("add_sql_port", $add_sql_port, 25), 381 CGI::br(), 382 CGI::small("Leave blank to use the default port."), 383 ), 384 ); 385 386 print CGI::Tr( 387 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 388 CGI::td( 389 CGI::textfield("add_sql_database", $add_sql_database, 25), 390 CGI::br(), 391 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 392 ), 393 ); 394 print CGI::Tr( 395 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 396 CGI::td( 397 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25), 398 CGI::br(), 399 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."), 400 ), 401 ); 402 print CGI::end_table(); 403 } elsif ($dbLayout eq "gdbm") { 404 print CGI::start_table({class=>"FormLayout"}); 405 print CGI::Tr( 406 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 407 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)), 408 ); 409 print CGI::end_table(); 410 } 411 412 print CGI::end_td(); 413 print CGI::end_Tr(); 414 print CGI::end_table(); 415 } 416 417 418 419 420 421 422 423 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 424 425 print CGI::end_form(); 426 } 427 428 sub add_course_validate { 429 my ($self) = @_; 430 my $r = $self->r; 431 my $ce = $r->ce; 432 #my $db = $r->db; 433 #my $authz = $r->authz; 434 #my $urlpath = $r->urlpath; 435 436 my $add_courseID = $r->param("add_courseID") || ""; 437 my $add_dbLayout = $r->param("add_dbLayout") || ""; 438 my $add_sql_host = $r->param("add_sql_host") || ""; 439 my $add_sql_port = $r->param("add_sql_port") || ""; 440 my $add_sql_username = $r->param("add_sql_username") || ""; 441 my $add_sql_password = $r->param("add_sql_password") || ""; 442 my $add_sql_database = $r->param("add_sql_database") || ""; 443 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 444 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 445 my $add_initial_userID = $r->param("add_initial_userID") || ""; 446 my $add_initial_password = $r->param("add_initial_password") || ""; 447 my $add_initial_password_confirm = $r->param("add_initial_password_confirm") || ""; 448 my $add_templates_course = $r->param("add_templates_course") || ""; 449 my $add_contact_person = $r->param("add_contact_person") || ""; 450 my $add_contact_institution = $r->param("add_contact_institution") || ""; 451 my $add_contact_email = $r->param("add_contact_email") || ""; 452 my $add_course_title = $r->param("add_course_title") || ""; 453 my $add_admin_userID = $r->param("add_admin_userID") || ""; 454 my $add_admin_password = $r->param("add_admin_password") || ""; 455 456 my @errors; 457 458 if ($add_courseID eq "") { 459 push @errors, "You must specify a course name."; 460 } 461 if ($add_contact_institution eq "") { 462 push @errors, "You must specify a contact institution." ; 463 } 464 if ($add_contact_person eq "") { 465 push @errors, "You must specify a contact person."; 466 } 467 if ($add_contact_email eq "") { 468 push @errors, "You must specify an email address for the contact person." ; 469 } 470 if ($add_initial_password ne $add_initial_password_confirm) { 471 push @errors, "The instructor's passwords don't match"; 472 } 473 if ($add_course_title eq "") { 474 push @errors, "You must specify a title for the course."; 475 } 476 477 if ($add_dbLayout eq "") { 478 push @errors, "You must select a database layout."; 479 } else { 480 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 481 if ($add_dbLayout eq "sql") { 482 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 483 #push @errors, "You must specify the SQL admin password." if $add_sql_password eq ""; 484 #push @errors, "You must specify the SQL database name." if $add_sql_database eq ""; 485 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 486 } elsif ($add_dbLayout eq "gdbm") { 487 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 488 } 489 } else { 490 push @errors, "The database layout $add_dbLayout doesn't exist."; 491 } 492 } 493 494 if ($add_initial_userID ne "") { 495 push @errors, "You must specify a professor password." if $add_initial_password eq ""; 496 } 497 if ($add_admin_userID ne "") { 498 push @errors, "You must specify an admin password for $add_admin_userID." if $add_admin_password eq ""; 499 } 500 501 502 return @errors; 503 } 504 505 sub do_add_course { 506 my ($self) = @_; 507 my $r = $self->r; 508 my $ce = $r->ce; 509 my $db = $r->db; 510 #my $authz = $r->authz; 511 my $urlpath = $r->urlpath; 512 513 my $add_courseID = $r->param("add_courseID") || ""; 514 my $add_dbLayout = $r->param("add_dbLayout") || ""; 515 my $add_sql_host = $r->param("add_sql_host") || ""; 516 my $add_sql_port = $r->param("add_sql_port") || ""; 517 my $add_sql_username = $r->param("add_sql_username") || ""; 518 my $add_sql_password = $r->param("add_sql_password") || ""; 519 my $add_sql_database = $r->param("add_sql_database") || ""; 520 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 521 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 522 my $add_initial_userID = $r->param("add_initial_userID") || ""; 523 my $add_initial_password = $r->param("add_initial_password") || ""; 524 my $add_templates_course = $r->param("add_templates_course") || ""; 525 my $add_contact_person = $r->param("add_contact_person") || ""; 526 my $add_contact_institution = $r->param("add_contact_institution") || ""; 527 my $add_contact_email = $r->param("add_contact_email") || ""; 528 my $add_course_title = $r->param("add_course_title") || ""; 529 my $add_admin_userID = $r->param("add_admin_userID") || $r->param("user") || ""; 530 my $add_admin_password = $r->param("add_admin_password") || ""; 531 532 my $ce2 = WeBWorK::CourseEnvironment->new( 533 $ce->{webworkDirs}->{root}, 534 $ce->{webworkURLs}->{root}, 535 $ce->{pg}->{directories}->{root}, 536 $add_courseID, 537 ); 538 539 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 540 if ($add_dbLayout eq "gdbm") { 541 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 542 } 543 544 my %dbOptions; 545 if ($add_dbLayout eq "sql") { 546 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 547 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 548 $dbOptions{username} = $add_sql_username; 549 $dbOptions{password} = $add_sql_password; 550 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID"; 551 $dbOptions{wwhost} = $add_sql_wwhost; 552 } 553 # add professor and administor if defined. 554 my @users; 555 if ($add_initial_userID ne "") { 556 my $User = $db->newUser( 557 user_id => $add_initial_userID, 558 status => "C", 559 ); 560 my $Password = $db->newPassword( 561 user_id => $add_initial_userID, 562 password => cryptPassword($add_initial_password), 563 ); 564 my $PermissionLevel = $db->newPermissionLevel( 565 user_id => $add_initial_userID, 566 permission => "10", 567 ); 568 push @users, [ $User, $Password, $PermissionLevel ]; 569 } 570 if ($add_admin_userID ne "") { 571 my $User = $db->newUser( 572 user_id => $add_admin_userID, 573 status => "C", 574 ); 575 my $Password = $db->newPassword( 576 user_id => $add_admin_userID, 577 password => cryptPassword($add_admin_password), 578 ); 579 my $PermissionLevel = $db->newPermissionLevel( 580 user_id => $add_admin_userID, 581 permission => "10", 582 ); 583 push @users, [ $User, $Password, $PermissionLevel ]; 584 } 585 my %optional_arguments; 586 if ($add_templates_course ne "") { 587 $optional_arguments{templatesFrom} = $add_templates_course; 588 } 589 590 eval { 591 addCourse( 592 courseID => $add_courseID, 593 ce => $ce2, 594 courseOptions => \%courseOptions, 595 dbOptions => \%dbOptions, 596 users => \@users, 597 %optional_arguments, 598 ); 599 }; 600 601 if ($@) { 602 my $error = $@; 603 print CGI::div({class=>"ResultsWithError"}, 604 CGI::p("An error occured while creating the course $add_courseID:"), 605 CGI::tt(CGI::escapeHTML($error)), 606 ); 607 # get rid of any partially built courses 608 # FIXME -- this is too fragile 609 unless ($error =~ /course exists/) { 610 eval { 611 deleteCourse( 612 courseID => $add_courseID, 613 ce => $ce2, 614 dbOptions => \%dbOptions, 615 ); 616 } 617 } 618 } else { 619 #log the action 620 writeLog($ce, "hosted_courses", join("\t", 621 "\tAdded", 622 $add_contact_institution, 623 $add_course_title, 624 $add_courseID, 625 $add_contact_person, 626 $add_contact_email, 627 )); 628 # add contact to admin course as student? 629 # FIXME -- should we do this? 630 print CGI::div({class=>"ResultsWithoutError"}, 631 CGI::p("Successfully created the course $add_courseID"), 632 ); 633 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 634 courseID => $add_courseID); 635 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 636 print CGI::div({style=>"text-align: center"}, 637 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 638 ); 639 } 640 } 641 642 ################################################################################ 643 644 sub delete_course_form { 645 my ($self) = @_; 646 my $r = $self->r; 647 my $ce = $r->ce; 648 #my $db = $r->db; 649 #my $authz = $r->authz; 650 #my $urlpath = $r->urlpath; 651 652 my $delete_courseID = $r->param("delete_courseID") || ""; 653 my $delete_sql_host = $r->param("delete_sql_host") || ""; 654 my $delete_sql_port = $r->param("delete_sql_port") || ""; 655 my $delete_sql_username = $r->param("delete_sql_username") || ""; 656 my $delete_sql_password = $r->param("delete_sql_password") || ""; 657 my $delete_sql_database = $r->param("delete_sql_database") || ""; 658 659 my @courseIDs = listCourses($ce); 660 @courseIDs = sort @courseIDs; 661 662 my %courseLabels; # records... heh. 663 foreach my $courseID (@courseIDs) { 664 my $tempCE = WeBWorK::CourseEnvironment->new( 665 $ce->{webworkDirs}->{root}, 666 $ce->{webworkURLs}->{root}, 667 $ce->{pg}->{directories}->{root}, 668 $courseID, 669 ); 670 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 671 } 672 673 print CGI::h2("Delete Course"); 674 675 print CGI::start_form("POST", $r->uri); 676 print $self->hidden_authen_fields; 677 print $self->hidden_fields("subDisplay"); 678 679 print CGI::p("Select a course to delete."); 680 681 print CGI::table({class=>"FormLayout"}, 682 CGI::Tr( 683 CGI::th({class=>"LeftHeader"}, "Course Name:"), 684 CGI::td( 685 CGI::scrolling_list( 686 -name => "delete_courseID", 687 -values => \@courseIDs, 688 -default => $delete_courseID, 689 -size => 10, 690 -multiple => 0, 691 -labels => \%courseLabels, 692 ), 693 ), 694 ), 695 ); 696 697 print CGI::p( 698 "If the course's database layout (indicated in parentheses above) is " 699 . CGI::b("sql") . ", supply the SQL connections information requested below." 700 ); 701 702 print CGI::start_table({class=>"FormLayout"}); 703 print CGI::Tr( 704 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 705 CGI::td( 706 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 707 CGI::br(), 708 CGI::small("Leave blank to use the default host."), 709 ), 710 ); 711 print CGI::Tr( 712 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 713 CGI::td( 714 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 715 CGI::br(), 716 CGI::small("Leave blank to use the default port."), 717 ), 718 ); 719 print CGI::Tr( 720 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 721 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 722 ); 723 print CGI::Tr( 724 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 725 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 726 ); 727 print CGI::Tr( 728 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 729 CGI::td( 730 CGI::textfield("delete_sql_database", $delete_sql_database, 25), 731 CGI::br(), 732 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 733 ), 734 ); 735 print CGI::end_table(); 736 737 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 738 739 print CGI::end_form(); 740 } 741 742 sub delete_course_validate { 743 my ($self) = @_; 744 my $r = $self->r; 745 my $ce = $r->ce; 746 #my $db = $r->db; 747 #my $authz = $r->authz; 748 my $urlpath = $r->urlpath; 749 750 my $delete_courseID = $r->param("delete_courseID") || ""; 751 my $delete_sql_host = $r->param("delete_sql_host") || ""; 752 my $delete_sql_port = $r->param("delete_sql_port") || ""; 753 my $delete_sql_username = $r->param("delete_sql_username") || ""; 754 my $delete_sql_password = $r->param("delete_sql_password") || ""; 755 my $delete_sql_database = $r->param("delete_sql_database") || ""; 756 757 my @errors; 758 759 if ($delete_courseID eq "") { 760 push @errors, "You must specify a course name."; 761 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 762 push @errors, "You cannot delete the course you are currently using."; 763 } 764 765 my $ce2 = WeBWorK::CourseEnvironment->new( 766 $ce->{webworkDirs}->{root}, 767 $ce->{webworkURLs}->{root}, 768 $ce->{pg}->{directories}->{root}, 769 $delete_courseID, 770 ); 771 772 if ($ce2->{dbLayoutName} eq "sql") { 773 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 774 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 775 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 776 } 777 778 return @errors; 779 } 780 781 sub delete_course_confirm { 782 my ($self) = @_; 783 my $r = $self->r; 784 my $ce = $r->ce; 785 #my $db = $r->db; 786 #my $authz = $r->authz; 787 #my $urlpath = $r->urlpath; 788 789 print CGI::h2("Delete Course"); 790 791 my $delete_courseID = $r->param("delete_courseID") || ""; 792 my $delete_sql_host = $r->param("delete_sql_host") || ""; 793 my $delete_sql_port = $r->param("delete_sql_port") || ""; 794 my $delete_sql_database = $r->param("delete_sql_database") || ""; 795 796 my $ce2 = WeBWorK::CourseEnvironment->new( 797 $ce->{webworkDirs}->{root}, 798 $ce->{webworkURLs}->{root}, 799 $ce->{pg}->{directories}->{root}, 800 $delete_courseID, 801 ); 802 803 if ($ce2->{dbLayoutName} eq "sql") { 804 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 805 . "? All course files and data and the following database will be destroyed." 806 . " There is no undo available."); 807 808 print CGI::table({class=>"FormLayout"}, 809 CGI::Tr( 810 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 811 CGI::td($delete_sql_host || "system default"), 812 ), 813 CGI::Tr( 814 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 815 CGI::td($delete_sql_port || "system default"), 816 ), 817 CGI::Tr( 818 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 819 CGI::td($delete_sql_database || "webwork_$delete_courseID"), 820 ), 821 ); 822 } else { 823 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 824 . "? All course files and data will be destroyed. There is no undo available."); 825 } 826 827 print CGI::start_form("POST", $r->uri); 828 print $self->hidden_authen_fields; 829 print $self->hidden_fields("subDisplay"); 830 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 831 832 print CGI::p({style=>"text-align: center"}, 833 CGI::submit("decline_delete_course", "Don't delete"), 834 " ", 835 CGI::submit("confirm_delete_course", "Delete"), 836 ); 837 838 print CGI::end_form(); 839 } 840 841 sub do_delete_course { 842 my ($self) = @_; 843 my $r = $self->r; 844 my $ce = $r->ce; 845 #my $db = $r->db; 846 #my $authz = $r->authz; 847 #my $urlpath = $r->urlpath; 848 849 my $delete_courseID = $r->param("delete_courseID") || ""; 850 my $delete_sql_host = $r->param("delete_sql_host") || ""; 851 my $delete_sql_port = $r->param("delete_sql_port") || ""; 852 my $delete_sql_username = $r->param("delete_sql_username") || ""; 853 my $delete_sql_password = $r->param("delete_sql_password") || ""; 854 my $delete_sql_database = $r->param("delete_sql_database") || ""; 855 856 my $ce2 = WeBWorK::CourseEnvironment->new( 857 $ce->{webworkDirs}->{root}, 858 $ce->{webworkURLs}->{root}, 859 $ce->{pg}->{directories}->{root}, 860 $delete_courseID, 861 ); 862 863 my %dbOptions; 864 if ($ce2->{dbLayoutName} eq "sql") { 865 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 866 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 867 $dbOptions{username} = $delete_sql_username; 868 $dbOptions{password} = $delete_sql_password; 869 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID"; 870 } 871 872 eval { 873 deleteCourse( 874 courseID => $delete_courseID, 875 ce => $ce2, 876 dbOptions => \%dbOptions, 877 ); 878 }; 879 880 if ($@) { 881 my $error = $@; 882 print CGI::div({class=>"ResultsWithError"}, 883 CGI::p("An error occured while deleting the course $delete_courseID:"), 884 CGI::tt(CGI::escapeHTML($error)), 885 ); 886 } else { 887 print CGI::div({class=>"ResultsWithoutError"}, 888 CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"), 889 ); 890 writeLog($ce, "hosted_courses", join("\t", 891 "\tDeleted", 892 "", 893 "", 894 $delete_courseID, 895 )); 896 print CGI::start_form("POST", $r->uri); 897 print $self->hidden_authen_fields; 898 print $self->hidden_fields("subDisplay"); 899 900 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 901 902 print CGI::end_form(); 903 } 904 } 905 906 ################################################################################ 907 908 sub export_database_form { 909 my ($self) = @_; 910 my $r = $self->r; 911 my $ce = $r->ce; 912 #my $db = $r->db; 913 #my $authz = $r->authz; 914 #my $urlpath = $r->urlpath; 915 916 my @tables = keys %{$ce->{dbLayout}}; 917 918 my $export_courseID = $r->param("export_courseID") || ""; 919 my @export_tables = $r->param("export_tables"); 920 921 @export_tables = @tables unless @export_tables; 922 923 my @courseIDs = listCourses($ce); 924 @courseIDs = sort @courseIDs; 925 926 my %courseLabels; # records... heh. 927 foreach my $courseID (@courseIDs) { 928 my $tempCE = WeBWorK::CourseEnvironment->new( 929 $ce->{webworkDirs}->{root}, 930 $ce->{webworkURLs}->{root}, 931 $ce->{pg}->{directories}->{root}, 932 $courseID, 933 ); 934 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 935 } 936 937 print CGI::h2("Export Database"); 938 939 print CGI::start_form("POST", $r->uri); 940 print $self->hidden_authen_fields; 941 print $self->hidden_fields("subDisplay"); 942 943 print CGI::p("Select a course to export the course's database."); 944 945 print CGI::table({class=>"FormLayout"}, 946 CGI::Tr( 947 CGI::th({class=>"LeftHeader"}, "Course Name:"), 948 CGI::td( 949 CGI::scrolling_list( 950 -name => "export_courseID", 951 -values => \@courseIDs, 952 -default => $export_courseID, 953 -size => 10, 954 -multiple => 0, 955 -labels => \%courseLabels, 956 ), 957 ), 958 ), 959 CGI::Tr( 960 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 961 CGI::td( 962 CGI::checkbox_group( 963 -name => "export_tables", 964 -values => \@tables, 965 -default => \@export_tables, 966 -linebreak => 1, 967 ), 968 ), 969 ), 970 ); 971 972 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 973 974 print CGI::end_form(); 975 } 976 977 sub export_database_validate { 978 my ($self) = @_; 979 my $r = $self->r; 980 #my $ce = $r->ce; 981 #my $db = $r->db; 982 #my $authz = $r->authz; 983 #my $urlpath = $r->urlpath; 984 985 my $export_courseID = $r->param("export_courseID") || ""; 986 my @export_tables = $r->param("export_tables"); 987 988 my @errors; 989 990 if ($export_courseID eq "") { 991 push @errors, "You must specify a course name."; 992 } 993 994 unless (@export_tables) { 995 push @errors, "You must specify at least one table to export."; 996 } 997 998 return @errors; 999 } 1000 1001 sub do_export_database { 1002 my ($self) = @_; 1003 my $r = $self->r; 1004 my $ce = $r->ce; 1005 #my $db = $r->db; 1006 #my $authz = $r->authz; 1007 my $urlpath = $r->urlpath; 1008 1009 my $export_courseID = $r->param("export_courseID"); 1010 my @export_tables = $r->param("export_tables"); 1011 1012 my $ce2 = WeBWorK::CourseEnvironment->new( 1013 $ce->{webworkDirs}->{root}, 1014 $ce->{webworkURLs}->{root}, 1015 $ce->{pg}->{directories}->{root}, 1016 $export_courseID, 1017 ); 1018 1019 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1020 1021 my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1022 my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1023 1024 my @errors; 1025 1026 eval { 1027 @errors = dbExport( 1028 db => $db2, 1029 xml => $fh, 1030 tables => \@export_tables, 1031 ); 1032 }; 1033 1034 push @errors, "Fatal exception: $@" if $@; 1035 1036 if (@errors) { 1037 print CGI::div({class=>"ResultsWithError"}, 1038 CGI::p("An error occured while exporting the database of course $export_courseID:"), 1039 CGI::ul(CGI::li(\@errors)), 1040 ); 1041 } else { 1042 print CGI::div({class=>"ResultsWithoutError"}, 1043 CGI::p("Export succeeded."), 1044 ); 1045 1046 print CGI::div({style=>"text-align: center"}, 1047 CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1048 ); 1049 } 1050 } 1051 1052 ################################################################################ 1053 1054 sub import_database_form { 1055 my ($self) = @_; 1056 my $r = $self->r; 1057 my $ce = $r->ce; 1058 #my $db = $r->db; 1059 #my $authz = $r->authz; 1060 #my $urlpath = $r->urlpath; 1061 1062 my @tables = keys %{$ce->{dbLayout}}; 1063 1064 my $import_file = $r->param("import_file") || ""; 1065 my $import_courseID = $r->param("import_courseID") || ""; 1066 my @import_tables = $r->param("import_tables"); 1067 my $import_conflict = $r->param("import_conflict") || "skip"; 1068 1069 @import_tables = @tables unless @import_tables; 1070 1071 my @courseIDs = listCourses($ce); 1072 @courseIDs = sort @courseIDs; 1073 1074 1075 my %courseLabels; # records... heh. 1076 foreach my $courseID (@courseIDs) { 1077 my $tempCE = WeBWorK::CourseEnvironment->new( 1078 $ce->{webworkDirs}->{root}, 1079 $ce->{webworkURLs}->{root}, 1080 $ce->{pg}->{directories}->{root}, 1081 $courseID, 1082 ); 1083 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1084 } 1085 1086 print CGI::h2("Import Database"); 1087 1088 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1089 print $self->hidden_authen_fields; 1090 print $self->hidden_fields("subDisplay"); 1091 1092 print CGI::table({class=>"FormLayout"}, 1093 CGI::Tr( 1094 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1095 CGI::td( 1096 CGI::filefield( 1097 -name => "import_file", 1098 -size => 50, 1099 ), 1100 ), 1101 ), 1102 CGI::Tr( 1103 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1104 CGI::td( 1105 CGI::checkbox_group( 1106 -name => "import_tables", 1107 -values => \@tables, 1108 -default => \@import_tables, 1109 -linebreak => 1, 1110 ), 1111 ), 1112 ), 1113 CGI::Tr( 1114 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1115 CGI::td( 1116 CGI::scrolling_list( 1117 -name => "import_courseID", 1118 -values => \@courseIDs, 1119 -default => $import_courseID, 1120 -size => 10, 1121 -multiple => 0, 1122 -labels => \%courseLabels, 1123 ), 1124 ), 1125 ), 1126 CGI::Tr( 1127 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1128 CGI::td( 1129 CGI::radio_group( 1130 -name => "import_conflict", 1131 -values => [qw/skip replace/], 1132 -default => $import_conflict, 1133 -linebreak=>'true', 1134 -labels => { 1135 skip => "Skip duplicate records", 1136 replace => "Replace duplicate records", 1137 }, 1138 ), 1139 ), 1140 ), 1141 ); 1142 1143 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1144 1145 print CGI::end_form(); 1146 } 1147 1148 sub import_database_validate { 1149 my ($self) = @_; 1150 my $r = $self->r; 1151 #my $ce = $r->ce; 1152 #my $db = $r->db; 1153 #my $authz = $r->authz; 1154 #my $urlpath = $r->urlpath; 1155 1156 my $import_file = $r->param("import_file") || ""; 1157 my $import_courseID = $r->param("import_courseID") || ""; 1158 my @import_tables = $r->param("import_tables"); 1159 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1160 1161 my @errors; 1162 1163 if ($import_file eq "") { 1164 push @errors, "You must specify a database file to upload."; 1165 } 1166 1167 if ($import_courseID eq "") { 1168 push @errors, "You must specify a course name."; 1169 } 1170 1171 unless (@import_tables) { 1172 push @errors, "You must specify at least one table to import."; 1173 } 1174 1175 return @errors; 1176 } 1177 1178 sub do_import_database { 1179 my ($self) = @_; 1180 my $r = $self->r; 1181 my $ce = $r->ce; 1182 #my $db = $r->db; 1183 #my $authz = $r->authz; 1184 my $urlpath = $r->urlpath; 1185 1186 my $import_file = $r->param("import_file"); 1187 my $import_courseID = $r->param("import_courseID"); 1188 my @import_tables = $r->param("import_tables"); 1189 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1190 1191 my $ce2 = WeBWorK::CourseEnvironment->new( 1192 $ce->{webworkDirs}->{root}, 1193 $ce->{webworkURLs}->{root}, 1194 $ce->{pg}->{directories}->{root}, 1195 $import_courseID, 1196 ); 1197 1198 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1199 1200 # retrieve upload from upload cache 1201 my ($id, $hash) = split /\s+/, $import_file; 1202 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1203 dir => $ce->{webworkDirs}->{uploadCache} 1204 ); 1205 1206 my @errors; 1207 1208 eval { 1209 @errors = dbImport( 1210 db => $db2, 1211 xml => $upload->fileHandle, 1212 tables => \@import_tables, 1213 conflict => $import_conflict, 1214 ); 1215 }; 1216 1217 $upload->dispose; 1218 1219 push @errors, "Fatal exception: $@" if $@; 1220 1221 if (@errors) { 1222 print CGI::div({class=>"ResultsWithError"}, 1223 CGI::p("An error occured while importing the database of course $import_courseID:"), 1224 CGI::ul(CGI::li(\@errors)), 1225 ); 1226 } else { 1227 print CGI::div({class=>"ResultsWithoutError"}, 1228 CGI::p("Import succeeded."), 1229 ); 1230 } 1231 } 1232 1233 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |