Parent Directory
| 
Revision Log
an ugly hack to convince safari to download the damn file! apparently just sending a "Content-Disposition: attachment" header isn't enough. it has to be a BINARY FILE! WTF! better solutions welcome.
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.23 2004/07/10 16:06:59 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 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 the user is asking for the downloaded database... 52 #if (defined $r->param("download_exported_database")) { 53 # my $courseID = $r->param("export_courseID"); 54 # my $random_chars = $r->param("download_exported_database"); 55 # 56 # die "courseID not specified" unless defined $courseID; 57 # die "invalid file specification" unless $random_chars =~ m/^\w+$/; 58 # 59 # my $tempdir = $ce->{webworkDirs}->{tmp}; 60 # my $export_file = "$tempdir/db_export_$random_chars"; 61 # 62 # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0); 63 # 64 # return ""; 65 #} 66 # 67 ## otherwise... 68 69 my @errors; 70 my $method_to_call; 71 72 my $subDisplay = $r->param("subDisplay"); 73 if (defined $subDisplay) { 74 75 if ($subDisplay eq "add_course") { 76 if (defined $r->param("add_course")) { 77 @errors = $self->add_course_validate; 78 if (@errors) { 79 $method_to_call = "add_course_form"; 80 } else { 81 $method_to_call = "do_add_course"; 82 } 83 } else { 84 $method_to_call = "add_course_form"; 85 } 86 } 87 88 elsif ($subDisplay eq "delete_course") { 89 if (defined $r->param("delete_course")) { 90 # validate or confirm 91 @errors = $self->delete_course_validate; 92 if (@errors) { 93 $method_to_call = "delete_course_form"; 94 } else { 95 $method_to_call = "delete_course_confirm"; 96 } 97 } elsif (defined $r->param("confirm_delete_course")) { 98 # validate and delete 99 @errors = $self->delete_course_validate; 100 if (@errors) { 101 $method_to_call = "delete_course_form"; 102 } else { 103 $method_to_call = "do_delete_course"; 104 } 105 } else { 106 # form only 107 $method_to_call = "delete_course_form"; 108 } 109 } 110 111 elsif ($subDisplay eq "export_database") { 112 if (defined $r->param("export_database")) { 113 @errors = $self->export_database_validate; 114 if (@errors) { 115 $method_to_call = "export_database_form"; 116 } else { 117 # we have to do something special here, since we're sending 118 # the database as we export it. $method_to_call still gets 119 # set here, but it gets caught by header() and content() 120 # below instead of by body(). 121 $method_to_call = "do_export_database"; 122 } 123 } else { 124 $method_to_call = "export_database_form"; 125 } 126 } 127 128 elsif ($subDisplay eq "import_database") { 129 if (defined $r->param("import_database")) { 130 @errors = $self->import_database_validate; 131 if (@errors) { 132 $method_to_call = "import_database_form"; 133 } else { 134 $method_to_call = "do_import_database"; 135 } 136 } else { 137 $method_to_call = "import_database_form"; 138 } 139 } 140 141 else { 142 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 143 } 144 145 } 146 147 $self->{errors} = \@errors; 148 $self->{method_to_call} = $method_to_call; 149 } 150 151 sub header { 152 my ($self) = @_; 153 my $method_to_call = $self->{method_to_call}; 154 if (defined $method_to_call and $method_to_call eq "do_export_database") { 155 my $r = $self->r; 156 my $courseID = $r->param("export_courseID"); 157 $r->content_type("application/octet-stream"); 158 $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 159 $r->send_http_header; 160 } else { 161 $self->SUPER::header; 162 } 163 } 164 165 # sends: 166 # 167 # HTTP/1.1 200 OK 168 # Date: Fri, 09 Jul 2004 19:05:55 GMT 169 # Server: Apache/1.3.27 (Unix) mod_perl/1.27 170 # Content-Disposition: attachment; filename="mth143_database.xml" 171 # Connection: close 172 # Content-Type: application/octet-stream 173 174 sub content { 175 my ($self) = @_; 176 my $method_to_call = $self->{method_to_call}; 177 if (defined $method_to_call and $method_to_call eq "do_export_database") { 178 print "<!-- Ϸĩ½ōú -->\n"; 179 print "<!-- Those were some high-bit characters to convince Safari that we really do want this saved as a file. -->\n"; 180 $self->do_export_database; 181 } else { 182 $self->SUPER::content; 183 } 184 } 185 186 sub body { 187 my ($self) = @_; 188 my $r = $self->r; 189 my $ce = $r->ce; 190 my $db = $r->db; 191 my $authz = $r->authz; 192 my $urlpath = $r->urlpath; 193 194 my $user = $r->param('user'); 195 196 # check permissions 197 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 198 return ""; 199 } 200 201 print CGI::p({style=>"text-align: center"}, 202 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 203 " | ", 204 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 205 " | ", 206 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 207 " | ", 208 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 209 ); 210 211 print CGI::hr(); 212 213 my @errors = @{$self->{errors}}; 214 my $method_to_call = $self->{method_to_call}; 215 216 if (@errors) { 217 print CGI::div({class=>"ResultsWithError"}, 218 CGI::p("Please correct the following errors and try again:"), 219 CGI::ul(CGI::li(\@errors)), 220 ); 221 } 222 223 if (defined $method_to_call and $method_to_call ne "") { 224 $self->$method_to_call; 225 } 226 227 return ""; 228 } 229 230 ################################################################################ 231 232 sub add_course_form { 233 my ($self) = @_; 234 my $r = $self->r; 235 my $ce = $r->ce; 236 #my $db = $r->db; 237 #my $authz = $r->authz; 238 #my $urlpath = $r->urlpath; 239 240 my $add_courseID = $r->param("add_courseID") || ""; 241 my $add_courseTitle = $r->param("add_courseTitle") || ""; 242 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 243 244 my $add_admin_users = $r->param("add_admin_users") || ""; 245 246 my $add_initial_userID = $r->param("add_initial_userID") || ""; 247 my $add_initial_password = $r->param("add_initial_password") || ""; 248 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 249 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 250 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 251 my $add_initial_email = $r->param("add_initial_email") || ""; 252 253 my $add_templates_course = $r->param("add_templates_course") || ""; 254 255 my $add_dbLayout = $r->param("add_dbLayout") || ""; 256 my $add_sql_host = $r->param("add_sql_host") || ""; 257 my $add_sql_port = $r->param("add_sql_port") || ""; 258 my $add_sql_username = $r->param("add_sql_username") || ""; 259 my $add_sql_password = $r->param("add_sql_password") || ""; 260 my $add_sql_database = $r->param("add_sql_database") || ""; 261 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 262 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 263 264 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 265 266 my $ce2 = WeBWorK::CourseEnvironment->new( 267 $ce->{webworkDirs}->{root}, 268 $ce->{webworkURLs}->{root}, 269 $ce->{pg}->{directories}->{root}, 270 "COURSENAME", 271 ); 272 273 my $dbi_source = do { 274 # find the most common SQL source (stolen from CourseManagement.pm) 275 my %sources; 276 foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) { 277 $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++; 278 } 279 my $source; 280 if (keys %sources > 1) { 281 foreach my $curr (keys %sources) { 282 $source = $curr if not defined $source or 283 $sources{$curr} > $sources{$source}; 284 } 285 } else { 286 ($source) = keys %sources; 287 } 288 $source; 289 }; 290 291 my @existingCourses = listCourses($ce); 292 @existingCourses = sort @existingCourses; 293 294 print CGI::h2("Add Course"); 295 296 print CGI::start_form("POST", $r->uri); 297 print $self->hidden_authen_fields; 298 print $self->hidden_fields("subDisplay"); 299 300 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 301 302 print CGI::table({class=>"FormLayout"}, 303 CGI::Tr( 304 CGI::th({class=>"LeftHeader"}, "Course ID:"), 305 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 306 ), 307 CGI::Tr( 308 CGI::th({class=>"LeftHeader"}, "Course Title:"), 309 CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)), 310 ), 311 CGI::Tr( 312 CGI::th({class=>"LeftHeader"}, "Institution:"), 313 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)), 314 ), 315 ); 316 317 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 318 319 print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course")); 320 321 print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only numbers, letters, hyphens, and underscores."); 322 323 print CGI::table({class=>"FormLayout"}, CGI::Tr( 324 CGI::td( 325 CGI::table({class=>"FormLayout"}, 326 CGI::Tr( 327 CGI::th({class=>"LeftHeader"}, "User ID:"), 328 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)), 329 ), 330 CGI::Tr( 331 CGI::th({class=>"LeftHeader"}, "Password:"), 332 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 333 ), 334 CGI::Tr( 335 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 336 CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)), 337 ), 338 ), 339 ), 340 CGI::td( 341 CGI::table({class=>"FormLayout"}, 342 CGI::Tr( 343 CGI::th({class=>"LeftHeader"}, "First Name:"), 344 CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)), 345 ), 346 CGI::Tr( 347 CGI::th({class=>"LeftHeader"}, "Last Name:"), 348 CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)), 349 ), 350 CGI::Tr( 351 CGI::th({class=>"LeftHeader"}, "Email Address:"), 352 CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)), 353 ), 354 ), 355 356 ), 357 )); 358 359 print CGI::p("To copy problem templates from an existing course, select the course below."); 360 361 print CGI::table({class=>"FormLayout"}, 362 CGI::Tr( 363 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 364 CGI::td( 365 CGI::popup_menu( 366 -name => "add_templates_course", 367 -values => [ "", @existingCourses ], 368 -default => $add_templates_course, 369 #-size => 10, 370 #-multiple => 0, 371 #-labels => \%courseLabels, 372 ), 373 374 ), 375 ), 376 ); 377 378 print CGI::p("Select a database layout below."); 379 380 foreach my $dbLayout (@dbLayouts) { 381 print CGI::start_table({class=>"FormLayout"}); 382 383 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 384 print CGI::Tr( 385 CGI::td({style=>"text-align: right"}, 386 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 387 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 388 ), 389 CGI::td($dbLayout), 390 ); 391 392 print CGI::start_Tr(); 393 print CGI::td(); # for indentation :( 394 print CGI::start_td(); 395 396 if ($dbLayout eq "sql") { 397 print CGI::start_table({class=>"FormLayout"}); 398 print CGI::Tr(CGI::td({colspan=>2}, 399 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database." 400 ) 401 ); 402 print CGI::Tr( 403 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 404 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)), 405 ); 406 print CGI::Tr( 407 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 408 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)), 409 ); 410 411 print CGI::Tr(CGI::td({colspan=>2}, 412 "The optionial SQL settings you enter below must match the settings in the DBI source" 413 . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME") 414 . " with the course name you entered above." 415 ) 416 ); 417 print CGI::Tr( 418 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 419 CGI::td( 420 CGI::textfield("add_sql_host", $add_sql_host, 25), 421 CGI::br(), 422 CGI::small("Leave blank to use the default host."), 423 ), 424 ); 425 print CGI::Tr( 426 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 427 CGI::td( 428 CGI::textfield("add_sql_port", $add_sql_port, 25), 429 CGI::br(), 430 CGI::small("Leave blank to use the default port."), 431 ), 432 ); 433 434 print CGI::Tr( 435 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 436 CGI::td( 437 CGI::textfield("add_sql_database", $add_sql_database, 25), 438 CGI::br(), 439 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 440 ), 441 ); 442 print CGI::Tr( 443 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"), 444 CGI::td( 445 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25), 446 CGI::br(), 447 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."), 448 ), 449 ); 450 print CGI::end_table(); 451 } elsif ($dbLayout eq "gdbm") { 452 print CGI::start_table({class=>"FormLayout"}); 453 print CGI::Tr( 454 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 455 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)), 456 ); 457 print CGI::end_table(); 458 } 459 460 print CGI::end_td(); 461 print CGI::end_Tr(); 462 print CGI::end_table(); 463 } 464 465 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 466 467 print CGI::end_form(); 468 } 469 470 sub add_course_validate { 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_courseTitle = $r->param("add_courseTitle") || ""; 480 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 481 482 my $add_admin_users = $r->param("add_admin_users") || ""; 483 484 my $add_initial_userID = $r->param("add_initial_userID") || ""; 485 my $add_initial_password = $r->param("add_initial_password") || ""; 486 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 487 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 488 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 489 my $add_initial_email = $r->param("add_initial_email") || ""; 490 491 my $add_templates_course = $r->param("add_templates_course") || ""; 492 493 my $add_dbLayout = $r->param("add_dbLayout") || ""; 494 my $add_sql_host = $r->param("add_sql_host") || ""; 495 my $add_sql_port = $r->param("add_sql_port") || ""; 496 my $add_sql_username = $r->param("add_sql_username") || ""; 497 my $add_sql_password = $r->param("add_sql_password") || ""; 498 my $add_sql_database = $r->param("add_sql_database") || ""; 499 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 500 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 501 502 my @errors; 503 504 if ($add_courseID eq "") { 505 push @errors, "You must specify a course ID."; 506 } 507 if (grep { $add_courseID eq $_ } listCourses($ce)) { 508 push @errors, "A course with ID $add_courseID already exists."; 509 } 510 if ($add_courseTitle eq "") { 511 push @errors, "You must specify a course title."; 512 } 513 if ($add_courseInstitution eq "") { 514 push @errors, "You must specify an institution for this course."; 515 } 516 517 if ($add_initial_userID ne "") { 518 if ($add_initial_password eq "") { 519 push @errors, "You must specify a password for the initial instructor."; 520 } 521 if ($add_initial_confirmPassword eq "") { 522 push @errors, "You must confirm the password for the initial instructor."; 523 } 524 if ($add_initial_password ne $add_initial_confirmPassword) { 525 push @errors, "The password and password confirmation for the instructor must match."; 526 } 527 if ($add_initial_firstName eq "") { 528 push @errors, "You must specify a first name for the initial instructor."; 529 } 530 if ($add_initial_lastName eq "") { 531 push @errors, "You must specify a last name for the initial instructor."; 532 } 533 if ($add_initial_email eq "") { 534 push @errors, "You must specify an email address for the initial instructor."; 535 } 536 } 537 538 if ($add_dbLayout eq "") { 539 push @errors, "You must select a database layout."; 540 } else { 541 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 542 if ($add_dbLayout eq "sql") { 543 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 544 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq ""; 545 } elsif ($add_dbLayout eq "gdbm") { 546 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq ""; 547 } 548 } else { 549 push @errors, "The database layout $add_dbLayout doesn't exist."; 550 } 551 } 552 553 return @errors; 554 } 555 556 sub do_add_course { 557 my ($self) = @_; 558 my $r = $self->r; 559 my $ce = $r->ce; 560 my $db = $r->db; 561 #my $authz = $r->authz; 562 my $urlpath = $r->urlpath; 563 564 my $add_courseID = $r->param("add_courseID") || ""; 565 my $add_courseTitle = $r->param("add_courseTitle") || ""; 566 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 567 568 my $add_admin_users = $r->param("add_admin_users") || ""; 569 570 my $add_initial_userID = $r->param("add_initial_userID") || ""; 571 my $add_initial_password = $r->param("add_initial_password") || ""; 572 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 573 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 574 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 575 my $add_initial_email = $r->param("add_initial_email") || ""; 576 577 my $add_templates_course = $r->param("add_templates_course") || ""; 578 579 my $add_dbLayout = $r->param("add_dbLayout") || ""; 580 my $add_sql_host = $r->param("add_sql_host") || ""; 581 my $add_sql_port = $r->param("add_sql_port") || ""; 582 my $add_sql_username = $r->param("add_sql_username") || ""; 583 my $add_sql_password = $r->param("add_sql_password") || ""; 584 my $add_sql_database = $r->param("add_sql_database") || ""; 585 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 586 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 587 588 my $ce2 = WeBWorK::CourseEnvironment->new( 589 $ce->{webworkDirs}->{root}, 590 $ce->{webworkURLs}->{root}, 591 $ce->{pg}->{directories}->{root}, 592 $add_courseID, 593 ); 594 595 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 596 597 if ($add_initial_email ne "") { 598 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 599 $courseOptions{feedbackRecipients} = [ $add_initial_email ]; 600 } 601 602 if ($add_dbLayout eq "gdbm") { 603 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 604 } 605 606 my %dbOptions; 607 if ($add_dbLayout eq "sql") { 608 $dbOptions{host} = $add_sql_host if $add_sql_host ne ""; 609 $dbOptions{port} = $add_sql_port if $add_sql_port ne ""; 610 $dbOptions{username} = $add_sql_username; 611 $dbOptions{password} = $add_sql_password; 612 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID"; 613 $dbOptions{wwhost} = $add_sql_wwhost; 614 } 615 616 my @users; 617 618 # copy users from current (admin) course if desired 619 if ($add_admin_users ne "") { 620 foreach my $userID ($db->listUsers) { 621 my $User = $db->getUser($userID); 622 my $Password = $db->getPassword($userID); 623 my $PermissionLevel = $db->getPermissionLevel($userID); 624 push @users, [ $User, $Password, $PermissionLevel ]; 625 } 626 } 627 628 # add initial instructor if desired 629 if ($add_initial_userID ne "") { 630 my $User = $db->newUser( 631 user_id => $add_initial_userID, 632 first_name => $add_initial_firstName, 633 last_name => $add_initial_lastName, 634 student_id => $add_initial_userID, 635 email_address => $add_initial_email, 636 status => "C", 637 ); 638 my $Password = $db->newPassword( 639 user_id => $add_initial_userID, 640 password => cryptPassword($add_initial_password), 641 ); 642 my $PermissionLevel = $db->newPermissionLevel( 643 user_id => $add_initial_userID, 644 permission => "10", 645 ); 646 push @users, [ $User, $Password, $PermissionLevel ]; 647 } 648 649 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users; 650 651 my %optional_arguments; 652 if ($add_templates_course ne "") { 653 $optional_arguments{templatesFrom} = $add_templates_course; 654 } 655 656 eval { 657 addCourse( 658 courseID => $add_courseID, 659 ce => $ce2, 660 courseOptions => \%courseOptions, 661 dbOptions => \%dbOptions, 662 users => \@users, 663 %optional_arguments, 664 ); 665 }; 666 if ($@) { 667 my $error = $@; 668 print CGI::div({class=>"ResultsWithError"}, 669 CGI::p("An error occured while creating the course $add_courseID:"), 670 CGI::tt(CGI::escapeHTML($error)), 671 ); 672 # get rid of any partially built courses 673 # FIXME -- this is too fragile 674 unless ($error =~ /course exists/) { 675 eval { 676 deleteCourse( 677 courseID => $add_courseID, 678 ce => $ce2, 679 dbOptions => \%dbOptions, 680 ); 681 } 682 } 683 } else { 684 #log the action 685 writeLog($ce, "hosted_courses", join("\t", 686 "\tAdded", 687 $add_courseInstitution, 688 $add_courseTitle, 689 $add_courseID, 690 $add_initial_firstName, 691 $add_initial_lastName, 692 $add_initial_email, 693 )); 694 # add contact to admin course as student? 695 # FIXME -- should we do this? 696 print CGI::div({class=>"ResultsWithoutError"}, 697 CGI::p("Successfully created the course $add_courseID"), 698 ); 699 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 700 courseID => $add_courseID); 701 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 702 print CGI::div({style=>"text-align: center"}, 703 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 704 ); 705 } 706 707 708 } 709 710 ################################################################################ 711 712 sub delete_course_form { 713 my ($self) = @_; 714 my $r = $self->r; 715 my $ce = $r->ce; 716 #my $db = $r->db; 717 #my $authz = $r->authz; 718 #my $urlpath = $r->urlpath; 719 720 my $delete_courseID = $r->param("delete_courseID") || ""; 721 my $delete_sql_host = $r->param("delete_sql_host") || ""; 722 my $delete_sql_port = $r->param("delete_sql_port") || ""; 723 my $delete_sql_username = $r->param("delete_sql_username") || ""; 724 my $delete_sql_password = $r->param("delete_sql_password") || ""; 725 my $delete_sql_database = $r->param("delete_sql_database") || ""; 726 727 my @courseIDs = listCourses($ce); 728 @courseIDs = sort @courseIDs; 729 730 my %courseLabels; # records... heh. 731 foreach my $courseID (@courseIDs) { 732 my $tempCE = WeBWorK::CourseEnvironment->new( 733 $ce->{webworkDirs}->{root}, 734 $ce->{webworkURLs}->{root}, 735 $ce->{pg}->{directories}->{root}, 736 $courseID, 737 ); 738 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 739 } 740 741 print CGI::h2("Delete Course"); 742 743 print CGI::start_form("POST", $r->uri); 744 print $self->hidden_authen_fields; 745 print $self->hidden_fields("subDisplay"); 746 747 print CGI::p("Select a course to delete."); 748 749 print CGI::table({class=>"FormLayout"}, 750 CGI::Tr( 751 CGI::th({class=>"LeftHeader"}, "Course Name:"), 752 CGI::td( 753 CGI::scrolling_list( 754 -name => "delete_courseID", 755 -values => \@courseIDs, 756 -default => $delete_courseID, 757 -size => 10, 758 -multiple => 0, 759 -labels => \%courseLabels, 760 ), 761 ), 762 ), 763 ); 764 765 print CGI::p( 766 "If the course's database layout (indicated in parentheses above) is " 767 . CGI::b("sql") . ", supply the SQL connections information requested below." 768 ); 769 770 print CGI::start_table({class=>"FormLayout"}); 771 print CGI::Tr( 772 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 773 CGI::td( 774 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 775 CGI::br(), 776 CGI::small("Leave blank to use the default host."), 777 ), 778 ); 779 print CGI::Tr( 780 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 781 CGI::td( 782 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 783 CGI::br(), 784 CGI::small("Leave blank to use the default port."), 785 ), 786 ); 787 print CGI::Tr( 788 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"), 789 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)), 790 ); 791 print CGI::Tr( 792 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"), 793 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)), 794 ); 795 print CGI::Tr( 796 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 797 CGI::td( 798 CGI::textfield("delete_sql_database", $delete_sql_database, 25), 799 CGI::br(), 800 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."), 801 ), 802 ); 803 print CGI::end_table(); 804 805 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 806 807 print CGI::end_form(); 808 } 809 810 sub delete_course_validate { 811 my ($self) = @_; 812 my $r = $self->r; 813 my $ce = $r->ce; 814 #my $db = $r->db; 815 #my $authz = $r->authz; 816 my $urlpath = $r->urlpath; 817 818 my $delete_courseID = $r->param("delete_courseID") || ""; 819 my $delete_sql_host = $r->param("delete_sql_host") || ""; 820 my $delete_sql_port = $r->param("delete_sql_port") || ""; 821 my $delete_sql_username = $r->param("delete_sql_username") || ""; 822 my $delete_sql_password = $r->param("delete_sql_password") || ""; 823 my $delete_sql_database = $r->param("delete_sql_database") || ""; 824 825 my @errors; 826 827 if ($delete_courseID eq "") { 828 push @errors, "You must specify a course name."; 829 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 830 push @errors, "You cannot delete the course you are currently using."; 831 } 832 833 my $ce2 = WeBWorK::CourseEnvironment->new( 834 $ce->{webworkDirs}->{root}, 835 $ce->{webworkURLs}->{root}, 836 $ce->{pg}->{directories}->{root}, 837 $delete_courseID, 838 ); 839 840 if ($ce2->{dbLayoutName} eq "sql") { 841 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq ""; 842 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq ""; 843 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq ""; 844 } 845 846 return @errors; 847 } 848 849 sub delete_course_confirm { 850 my ($self) = @_; 851 my $r = $self->r; 852 my $ce = $r->ce; 853 #my $db = $r->db; 854 #my $authz = $r->authz; 855 #my $urlpath = $r->urlpath; 856 857 print CGI::h2("Delete Course"); 858 859 my $delete_courseID = $r->param("delete_courseID") || ""; 860 my $delete_sql_host = $r->param("delete_sql_host") || ""; 861 my $delete_sql_port = $r->param("delete_sql_port") || ""; 862 my $delete_sql_database = $r->param("delete_sql_database") || ""; 863 864 my $ce2 = WeBWorK::CourseEnvironment->new( 865 $ce->{webworkDirs}->{root}, 866 $ce->{webworkURLs}->{root}, 867 $ce->{pg}->{directories}->{root}, 868 $delete_courseID, 869 ); 870 871 if ($ce2->{dbLayoutName} eq "sql") { 872 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 873 . "? All course files and data and the following database will be destroyed." 874 . " There is no undo available."); 875 876 print CGI::table({class=>"FormLayout"}, 877 CGI::Tr( 878 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 879 CGI::td($delete_sql_host || "system default"), 880 ), 881 CGI::Tr( 882 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"), 883 CGI::td($delete_sql_port || "system default"), 884 ), 885 CGI::Tr( 886 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 887 CGI::td($delete_sql_database || "webwork_$delete_courseID"), 888 ), 889 ); 890 } else { 891 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 892 . "? All course files and data will be destroyed. There is no undo available."); 893 } 894 895 print CGI::start_form("POST", $r->uri); 896 print $self->hidden_authen_fields; 897 print $self->hidden_fields("subDisplay"); 898 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 899 900 print CGI::p({style=>"text-align: center"}, 901 CGI::submit("decline_delete_course", "Don't delete"), 902 " ", 903 CGI::submit("confirm_delete_course", "Delete"), 904 ); 905 906 print CGI::end_form(); 907 } 908 909 sub do_delete_course { 910 my ($self) = @_; 911 my $r = $self->r; 912 my $ce = $r->ce; 913 #my $db = $r->db; 914 #my $authz = $r->authz; 915 #my $urlpath = $r->urlpath; 916 917 my $delete_courseID = $r->param("delete_courseID") || ""; 918 my $delete_sql_host = $r->param("delete_sql_host") || ""; 919 my $delete_sql_port = $r->param("delete_sql_port") || ""; 920 my $delete_sql_username = $r->param("delete_sql_username") || ""; 921 my $delete_sql_password = $r->param("delete_sql_password") || ""; 922 my $delete_sql_database = $r->param("delete_sql_database") || ""; 923 924 my $ce2 = WeBWorK::CourseEnvironment->new( 925 $ce->{webworkDirs}->{root}, 926 $ce->{webworkURLs}->{root}, 927 $ce->{pg}->{directories}->{root}, 928 $delete_courseID, 929 ); 930 931 my %dbOptions; 932 if ($ce2->{dbLayoutName} eq "sql") { 933 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne ""; 934 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne ""; 935 $dbOptions{username} = $delete_sql_username; 936 $dbOptions{password} = $delete_sql_password; 937 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID"; 938 } 939 940 eval { 941 deleteCourse( 942 courseID => $delete_courseID, 943 ce => $ce2, 944 dbOptions => \%dbOptions, 945 ); 946 }; 947 948 if ($@) { 949 my $error = $@; 950 print CGI::div({class=>"ResultsWithError"}, 951 CGI::p("An error occured while deleting the course $delete_courseID:"), 952 CGI::tt(CGI::escapeHTML($error)), 953 ); 954 } else { 955 print CGI::div({class=>"ResultsWithoutError"}, 956 CGI::p("Successfully deleted the course $delete_courseID."), 957 ); 958 writeLog($ce, "hosted_courses", join("\t", 959 "\tDeleted", 960 "", 961 "", 962 $delete_courseID, 963 )); 964 print CGI::start_form("POST", $r->uri); 965 print $self->hidden_authen_fields; 966 print $self->hidden_fields("subDisplay"); 967 968 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 969 970 print CGI::end_form(); 971 } 972 } 973 974 ################################################################################ 975 976 sub export_database_form { 977 my ($self) = @_; 978 my $r = $self->r; 979 my $ce = $r->ce; 980 #my $db = $r->db; 981 #my $authz = $r->authz; 982 #my $urlpath = $r->urlpath; 983 984 my @tables = keys %{$ce->{dbLayout}}; 985 986 my $export_courseID = $r->param("export_courseID") || ""; 987 my @export_tables = $r->param("export_tables"); 988 989 @export_tables = @tables unless @export_tables; 990 991 my @courseIDs = listCourses($ce); 992 @courseIDs = sort @courseIDs; 993 994 my %courseLabels; # records... heh. 995 foreach my $courseID (@courseIDs) { 996 my $tempCE = WeBWorK::CourseEnvironment->new( 997 $ce->{webworkDirs}->{root}, 998 $ce->{webworkURLs}->{root}, 999 $ce->{pg}->{directories}->{root}, 1000 $courseID, 1001 ); 1002 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1003 } 1004 1005 print CGI::h2("Export Database"); 1006 1007 print CGI::start_form("GET", $r->uri); 1008 print $self->hidden_authen_fields; 1009 print $self->hidden_fields("subDisplay"); 1010 1011 print CGI::p("Select a course to export the course's database."); 1012 1013 print CGI::table({class=>"FormLayout"}, 1014 CGI::Tr( 1015 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1016 CGI::td( 1017 CGI::scrolling_list( 1018 -name => "export_courseID", 1019 -values => \@courseIDs, 1020 -default => $export_courseID, 1021 -size => 10, 1022 -multiple => 0, 1023 -labels => \%courseLabels, 1024 ), 1025 ), 1026 ), 1027 CGI::Tr( 1028 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1029 CGI::td( 1030 CGI::checkbox_group( 1031 -name => "export_tables", 1032 -values => \@tables, 1033 -default => \@export_tables, 1034 -linebreak => 1, 1035 ), 1036 ), 1037 ), 1038 ); 1039 1040 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 1041 1042 print CGI::end_form(); 1043 } 1044 1045 sub export_database_validate { 1046 my ($self) = @_; 1047 my $r = $self->r; 1048 #my $ce = $r->ce; 1049 #my $db = $r->db; 1050 #my $authz = $r->authz; 1051 #my $urlpath = $r->urlpath; 1052 1053 my $export_courseID = $r->param("export_courseID") || ""; 1054 my @export_tables = $r->param("export_tables"); 1055 1056 my @errors; 1057 1058 if ($export_courseID eq "") { 1059 push @errors, "You must specify a course name."; 1060 } 1061 1062 unless (@export_tables) { 1063 push @errors, "You must specify at least one table to export."; 1064 } 1065 1066 return @errors; 1067 } 1068 1069 sub do_export_database { 1070 my ($self) = @_; 1071 my $r = $self->r; 1072 my $ce = $r->ce; 1073 #my $db = $r->db; 1074 #my $authz = $r->authz; 1075 my $urlpath = $r->urlpath; 1076 1077 my $export_courseID = $r->param("export_courseID"); 1078 my @export_tables = $r->param("export_tables"); 1079 1080 my $ce2 = WeBWorK::CourseEnvironment->new( 1081 $ce->{webworkDirs}->{root}, 1082 $ce->{webworkURLs}->{root}, 1083 $ce->{pg}->{directories}->{root}, 1084 $export_courseID, 1085 ); 1086 1087 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1088 1089 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1090 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1091 1092 my @errors; 1093 1094 eval { 1095 @errors = dbExport( 1096 db => $db2, 1097 #xml => $fh, 1098 xml => *STDOUT, 1099 tables => \@export_tables, 1100 ); 1101 }; 1102 1103 #push @errors, "Fatal exception: $@" if $@; 1104 # 1105 #if (@errors) { 1106 # print CGI::div({class=>"ResultsWithError"}, 1107 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1108 # CGI::ul(CGI::li(\@errors)), 1109 # ); 1110 #} else { 1111 # print CGI::div({class=>"ResultsWithoutError"}, 1112 # CGI::p("Export succeeded."), 1113 # ); 1114 # 1115 # print CGI::div({style=>"text-align: center"}, 1116 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1117 # ); 1118 #} 1119 } 1120 1121 ################################################################################ 1122 1123 sub import_database_form { 1124 my ($self) = @_; 1125 my $r = $self->r; 1126 my $ce = $r->ce; 1127 #my $db = $r->db; 1128 #my $authz = $r->authz; 1129 #my $urlpath = $r->urlpath; 1130 1131 my @tables = keys %{$ce->{dbLayout}}; 1132 1133 my $import_file = $r->param("import_file") || ""; 1134 my $import_courseID = $r->param("import_courseID") || ""; 1135 my @import_tables = $r->param("import_tables"); 1136 my $import_conflict = $r->param("import_conflict") || "skip"; 1137 1138 @import_tables = @tables unless @import_tables; 1139 1140 my @courseIDs = listCourses($ce); 1141 @courseIDs = sort @courseIDs; 1142 1143 1144 my %courseLabels; # records... heh. 1145 foreach my $courseID (@courseIDs) { 1146 my $tempCE = WeBWorK::CourseEnvironment->new( 1147 $ce->{webworkDirs}->{root}, 1148 $ce->{webworkURLs}->{root}, 1149 $ce->{pg}->{directories}->{root}, 1150 $courseID, 1151 ); 1152 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1153 } 1154 1155 print CGI::h2("Import Database"); 1156 1157 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1158 print $self->hidden_authen_fields; 1159 print $self->hidden_fields("subDisplay"); 1160 1161 print CGI::table({class=>"FormLayout"}, 1162 CGI::Tr( 1163 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1164 CGI::td( 1165 CGI::filefield( 1166 -name => "import_file", 1167 -size => 50, 1168 ), 1169 ), 1170 ), 1171 CGI::Tr( 1172 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1173 CGI::td( 1174 CGI::checkbox_group( 1175 -name => "import_tables", 1176 -values => \@tables, 1177 -default => \@import_tables, 1178 -linebreak => 1, 1179 ), 1180 ), 1181 ), 1182 CGI::Tr( 1183 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1184 CGI::td( 1185 CGI::scrolling_list( 1186 -name => "import_courseID", 1187 -values => \@courseIDs, 1188 -default => $import_courseID, 1189 -size => 10, 1190 -multiple => 0, 1191 -labels => \%courseLabels, 1192 ), 1193 ), 1194 ), 1195 CGI::Tr( 1196 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1197 CGI::td( 1198 CGI::radio_group( 1199 -name => "import_conflict", 1200 -values => [qw/skip replace/], 1201 -default => $import_conflict, 1202 -linebreak=>'true', 1203 -labels => { 1204 skip => "Skip duplicate records", 1205 replace => "Replace duplicate records", 1206 }, 1207 ), 1208 ), 1209 ), 1210 ); 1211 1212 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1213 1214 print CGI::end_form(); 1215 } 1216 1217 sub import_database_validate { 1218 my ($self) = @_; 1219 my $r = $self->r; 1220 #my $ce = $r->ce; 1221 #my $db = $r->db; 1222 #my $authz = $r->authz; 1223 #my $urlpath = $r->urlpath; 1224 1225 my $import_file = $r->param("import_file") || ""; 1226 my $import_courseID = $r->param("import_courseID") || ""; 1227 my @import_tables = $r->param("import_tables"); 1228 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1229 1230 my @errors; 1231 1232 if ($import_file eq "") { 1233 push @errors, "You must specify a database file to upload."; 1234 } 1235 1236 if ($import_courseID eq "") { 1237 push @errors, "You must specify a course name."; 1238 } 1239 1240 unless (@import_tables) { 1241 push @errors, "You must specify at least one table to import."; 1242 } 1243 1244 return @errors; 1245 } 1246 1247 sub do_import_database { 1248 my ($self) = @_; 1249 my $r = $self->r; 1250 my $ce = $r->ce; 1251 #my $db = $r->db; 1252 #my $authz = $r->authz; 1253 my $urlpath = $r->urlpath; 1254 1255 my $import_file = $r->param("import_file"); 1256 my $import_courseID = $r->param("import_courseID"); 1257 my @import_tables = $r->param("import_tables"); 1258 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1259 1260 my $ce2 = WeBWorK::CourseEnvironment->new( 1261 $ce->{webworkDirs}->{root}, 1262 $ce->{webworkURLs}->{root}, 1263 $ce->{pg}->{directories}->{root}, 1264 $import_courseID, 1265 ); 1266 1267 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1268 1269 # retrieve upload from upload cache 1270 my ($id, $hash) = split /\s+/, $import_file; 1271 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1272 dir => $ce->{webworkDirs}->{uploadCache} 1273 ); 1274 1275 my @errors; 1276 1277 eval { 1278 @errors = dbImport( 1279 db => $db2, 1280 xml => $upload->fileHandle, 1281 tables => \@import_tables, 1282 conflict => $import_conflict, 1283 ); 1284 }; 1285 1286 $upload->dispose; 1287 1288 push @errors, "Fatal exception: $@" if $@; 1289 1290 if (@errors) { 1291 print CGI::div({class=>"ResultsWithError"}, 1292 CGI::p("An error occured while importing the database of course $import_courseID:"), 1293 CGI::ul(CGI::li(\@errors)), 1294 ); 1295 } else { 1296 print CGI::div({class=>"ResultsWithoutError"}, 1297 CGI::p("Import succeeded."), 1298 ); 1299 } 1300 } 1301 1302 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |