Parent Directory
| 
Revision Log
syning with head
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.86 2009/07/07 18:19:43 apizer 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 qw(-nosticky ); 29 use WeBWorK::CGI; 30 use Data::Dumper; 31 use File::Temp qw/tempfile/; 32 use WeBWorK::CourseEnvironment; 33 use IO::File; 34 use URI::Escape; 35 use WeBWorK::Debug; 36 use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive trim_spaces); 37 use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse 38 listArchivedCourses unarchiveCourse); 39 use WeBWorK::Utils::CourseIntegrityCheck; 40 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 41 # needed for location management 42 use Net::IP; 43 44 use constant IMPORT_EXPORT_WARNING => "The ability to import and export 45 databases is still under development. It seems to work but it is <b>VERY</b> 46 slow on large courses. You may prefer to use webwork2/bin/wwdb or the mysql 47 dump facility for archiving large courses. Please send bug reports if you find 48 errors."; 49 50 sub pre_header_initialize { 51 my ($self) = @_; 52 my $r = $self->r; 53 my $ce = $r->ce; 54 my $db = $r->db; 55 my $authz = $r->authz; 56 my $urlpath = $r->urlpath; 57 my $user = $r->param('user'); 58 59 # check permissions 60 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 61 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 62 return; 63 } 64 65 # get result and send to message 66 my $status_message = $r->param("status_message"); 67 $self->addmessage(CGI::p("$status_message")) if $status_message; 68 69 ## if the user is asking for the downloaded database... 70 #if (defined $r->param("download_exported_database")) { 71 # my $courseID = $r->param("export_courseID"); 72 # my $random_chars = $r->param("download_exported_database"); 73 # 74 # die "courseID not specified" unless defined $courseID; 75 # die "invalid file specification" unless $random_chars =~ m/^\w+$/; 76 # 77 # my $tempdir = $ce->{webworkDirs}->{tmp}; 78 # my $export_file = "$tempdir/db_export_$random_chars"; 79 # 80 # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0); 81 # 82 # return ""; 83 #} 84 # 85 ## otherwise... 86 87 my @errors; 88 my $method_to_call; 89 90 my $subDisplay = $r->param("subDisplay"); 91 if (defined $subDisplay) { 92 93 if ($subDisplay eq "add_course") { 94 if (defined $r->param("add_course")) { 95 @errors = $self->add_course_validate; 96 if (@errors) { 97 $method_to_call = "add_course_form"; 98 } else { 99 $method_to_call = "do_add_course"; 100 } 101 } else { 102 $method_to_call = "add_course_form"; 103 } 104 } 105 106 elsif ($subDisplay eq "rename_course") { 107 if (defined $r->param("rename_course")) { 108 @errors = $self->rename_course_validate; 109 if (@errors) { 110 $method_to_call = "rename_course_form"; 111 } else { 112 $method_to_call = "rename_course_confirm"; 113 } 114 } elsif (defined $r->param("confirm_rename_course")) { 115 # validate and delete 116 @errors = $self->rename_course_validate; 117 if (@errors) { 118 $method_to_call = "rename_course_form"; 119 } else { 120 $method_to_call = "do_rename_course"; 121 } 122 } elsif (defined $r->param("upgrade_course_tables") ){ 123 # upgrade and revalidate 124 @errors = $self->rename_course_validate; 125 if (@errors) { 126 $method_to_call = "rename_course_form"; 127 } else { 128 $method_to_call = "rename_course_confirm"; 129 } 130 131 } else { 132 $method_to_call = "rename_course_form"; 133 } 134 } 135 136 elsif ($subDisplay eq "delete_course") { 137 if (defined $r->param("delete_course")) { 138 # validate or confirm 139 @errors = $self->delete_course_validate; 140 if (@errors) { 141 $method_to_call = "delete_course_form"; 142 } else { 143 $method_to_call = "delete_course_confirm"; 144 } 145 } elsif (defined $r->param("confirm_delete_course")) { 146 # validate and delete 147 @errors = $self->delete_course_validate; 148 if (@errors) { 149 $method_to_call = "delete_course_form"; 150 } else { 151 $method_to_call = "do_delete_course"; 152 } 153 } else { 154 # form only 155 $method_to_call = "delete_course_form"; 156 } 157 } 158 159 elsif ($subDisplay eq "export_database") { 160 if (defined $r->param("export_database")) { 161 @errors = $self->export_database_validate; 162 if (@errors) { 163 $method_to_call = "export_database_form"; 164 } else { 165 # we have to do something special here, since we're sending 166 # the database as we export it. $method_to_call still gets 167 # set here, but it gets caught by header() and content() 168 # below instead of by body(). 169 $method_to_call = "do_export_database"; 170 } 171 } else { 172 $method_to_call = "export_database_form"; 173 } 174 } 175 176 elsif ($subDisplay eq "import_database") { 177 if (defined $r->param("import_database")) { 178 @errors = $self->import_database_validate; 179 if (@errors) { 180 $method_to_call = "import_database_form"; 181 } else { 182 $method_to_call = "do_import_database"; 183 } 184 } else { 185 $method_to_call = "import_database_form"; 186 } 187 } 188 189 elsif ($subDisplay eq "archive_course") { 190 if (defined $r->param("archive_course")) { 191 # validate or confirm 192 @errors = $self->archive_course_validate; 193 if (@errors) { 194 $method_to_call = "archive_course_form"; 195 } else { 196 $method_to_call = "archive_course_confirm"; 197 } 198 } elsif (defined $r->param("confirm_archive_course")) { 199 # validate and archive 200 @errors = $self->archive_course_validate; 201 if (@errors) { 202 $method_to_call = "archive_course_form"; 203 } else { 204 $method_to_call = "do_archive_course"; 205 } 206 } elsif (defined $r->param("upgrade_course_tables") ){ 207 # upgrade and revalidate 208 @errors = $self->archive_course_validate; 209 if (@errors) { 210 $method_to_call = "archive_course_form"; 211 } else { 212 $method_to_call = "archive_course_confirm"; 213 } 214 } else { 215 # form only 216 $method_to_call = "archive_course_form"; 217 } 218 } 219 elsif ($subDisplay eq "unarchive_course") { 220 if (defined $r->param("unarchive_course")) { 221 # validate or confirm 222 @errors = $self->unarchive_course_validate; 223 if (@errors) { 224 $method_to_call = "unarchive_course_form"; 225 } else { 226 $method_to_call = "unarchive_course_confirm"; 227 } 228 } elsif (defined $r->param("confirm_unarchive_course")) { 229 # validate and archive 230 @errors = $self->unarchive_course_validate; 231 if (@errors) { 232 $method_to_call = "unarchive_course_form"; 233 } else { 234 $method_to_call = "do_unarchive_course"; 235 } 236 } else { 237 # form only 238 $method_to_call = "unarchive_course_form"; 239 } 240 } 241 elsif ($subDisplay eq "manage_locations") { 242 if (defined ($r->param("manage_location_action"))) { 243 $method_to_call = 244 $r->param("manage_location_action"); 245 } 246 else{ 247 $method_to_call = "manage_location_form"; 248 } 249 } 250 elsif ($subDisplay eq "registration") { 251 if (defined ($r->param("register_site"))) { 252 $method_to_call = "do_registration"; 253 } 254 else{ 255 $method_to_call = "registration_form"; 256 } 257 } 258 else { 259 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 260 } 261 } 262 263 $self->{errors} = \@errors; 264 $self->{method_to_call} = $method_to_call; 265 } 266 267 sub header { 268 my ($self) = @_; 269 my $method_to_call = $self->{method_to_call}; 270 # if (defined $method_to_call and $method_to_call eq "do_export_database") { 271 # my $r = $self->r; 272 # my $courseID = $r->param("export_courseID"); 273 # $r->content_type("application/octet-stream"); 274 # $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 275 # $r->send_http_header; 276 # } else { 277 $self->SUPER::header; 278 # } 279 } 280 281 # sends: 282 # 283 # HTTP/1.1 200 OK 284 # Date: Fri, 09 Jul 2004 19:05:55 GMT 285 # Server: Apache/1.3.27 (Unix) mod_perl/1.27 286 # Content-Disposition: attachment; filename="mth143_database.xml" 287 # Connection: close 288 # Content-Type: application/octet-stream 289 290 sub content { 291 my ($self) = @_; 292 my $method_to_call = $self->{method_to_call}; 293 if (defined $method_to_call and $method_to_call eq "do_export_database") { 294 #$self->do_export_database; 295 $self->SUPER::content; 296 } else { 297 $self->SUPER::content; 298 } 299 } 300 301 sub body { 302 my ($self) = @_; 303 my $r = $self->r; 304 my $ce = $r->ce; 305 my $db = $r->db; 306 my $authz = $r->authz; 307 my $urlpath = $r->urlpath; 308 309 my $user = $r->param('user'); 310 311 # check permissions 312 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 313 return ""; 314 } 315 my $method_to_call = $self->{method_to_call}; 316 my $methodMessage =""; 317 318 (defined($method_to_call) and $method_to_call eq "do_export_database") && do { 319 my @export_courseID = $r->param("export_courseID"); 320 my $course_ids = join(", ", @export_courseID); 321 $methodMessage = CGI::p("Exporting database for course(s) $course_ids"). 322 CGI::p(".... please wait.... 323 If your browser times out you will 324 still be able to download the exported database using the 325 file manager.").CGI::hr(); 326 }; 327 328 329 print CGI::p({style=>"text-align: center"}, 330 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1, 331 add_dbLayout=>'sql_single', 332 add_templates_course => $ce->{siteDefaults}->{default_templates_course} ||""} 333 )}, 334 "Add Course" 335 ), 336 " | ", 337 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"), 338 " | ", 339 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 340 " | ", 341 # CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 342 # " | ", 343 # CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 344 # " | ", 345 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"), 346 "|", 347 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"), 348 "|", 349 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"manage_locations"})}, "Manage Locations"), 350 CGI::hr(), 351 $methodMessage, 352 353 ); 354 355 print( CGI::p({style=>"text-align: center"}, $self->display_registration_form() ) ) if $self->display_registration_form(); 356 357 358 my @errors = @{$self->{errors}}; 359 360 361 if (@errors) { 362 print CGI::div({class=>"ResultsWithError"}, 363 CGI::p("Please correct the following errors and try again:"), 364 CGI::ul(CGI::li(\@errors)), 365 ); 366 } 367 368 if (defined $method_to_call and $method_to_call ne "") { 369 $self->$method_to_call; 370 } else { 371 372 print CGI::h2("Courses"); 373 374 print CGI::start_ol(); 375 376 my @courseIDs = listCourses($ce); 377 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 378 next if $courseID eq "admin"; # done already above 379 next if $courseID eq "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc 380 my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID); 381 my $tempCE = new WeBWorK::CourseEnvironment({ 382 %WeBWorK::SeedCE, 383 courseName => $courseID, 384 }); 385 386 my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$tempCE); 387 my ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($courseID); 388 $CIchecker->updateCourseDirectories(); #creates missing html_temp, mailmerge tmpEditFileDir directories; 389 my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories(); 390 print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID), 391 CGI::code( 392 $tempCE->{dbLayoutName}, 393 ), 394 $directories_ok ? "" : CGI::span({style=>"color:red"},"Directory structure or permissions need to be repaired. "), 395 $tables_ok ? CGI::span({style=>"color:green"},"Database tables ok") : CGI::span({style=>"color:red"},"Database tables need updating."), 396 397 ); 398 399 } 400 401 print CGI::end_ol(); 402 403 print CGI::h2("Archived Courses"); 404 print CGI::start_ol(); 405 406 @courseIDs = listArchivedCourses($ce); 407 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 408 print CGI::li($courseID), 409 } 410 411 print CGI::end_ol(); 412 } 413 return ""; 414 } 415 416 ################################################################################ 417 418 sub add_course_form { 419 my ($self) = @_; 420 my $r = $self->r; 421 my $ce = $r->ce; 422 #my $db = $r->db; 423 #my $authz = $r->authz; 424 #my $urlpath = $r->urlpath; 425 426 my $add_courseID = trim_spaces( $r->param("add_courseID") ) || ""; 427 my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) || ""; 428 my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) || ""; 429 430 my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) || ""; 431 432 my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) || ""; 433 my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) || ""; 434 my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) || ""; 435 my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) || ""; 436 my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) || ""; 437 my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) || ""; 438 439 my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) || ""; 440 441 my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) || ""; 442 443 444 445 446 my @dbLayouts = do { 447 my @ordered_layouts; 448 foreach my $layout (@{$ce->{dbLayout_order}}) { 449 if (exists $ce->{dbLayouts}->{$layout}) { 450 push @ordered_layouts, $layout; 451 } 452 } 453 454 my %ordered_layouts; @ordered_layouts{@ordered_layouts} = (); 455 my @other_layouts; 456 foreach my $layout (keys %{ $ce->{dbLayouts} }) { 457 unless (exists $ordered_layouts{$layout}) { 458 push @other_layouts, $layout; 459 } 460 } 461 462 (@ordered_layouts, @other_layouts); 463 }; 464 465 # unused... 466 #my $ce2 = new WeBWorK::CourseEnvironment({ 467 # %WeBWorK::SeedCE, 468 # courseName => "COURSENAME", 469 #}); 470 471 my @existingCourses = listCourses($ce); 472 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive 473 474 print CGI::h2("Add Course"); 475 476 print CGI::start_form(-method=>"POST", -action=>$r->uri); 477 print $self->hidden_authen_fields; 478 print $self->hidden_fields("subDisplay"); 479 480 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 481 482 print CGI::table({class=>"FormLayout"}, 483 CGI::Tr({}, 484 CGI::th({class=>"LeftHeader"}, "Course ID:"), 485 CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)), 486 ), 487 CGI::Tr({}, 488 CGI::th({class=>"LeftHeader"}, "Course Title:"), 489 CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)), 490 ), 491 CGI::Tr({}, 492 CGI::th({class=>"LeftHeader"}, "Institution:"), 493 CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)), 494 ), 495 ); 496 497 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 498 my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked. 499 print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course")); 500 501 print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only 502 numbers, letters, hyphens, periods (dots), commas,and underscores.\n"); 503 504 print CGI::table({class=>"FormLayout"}, CGI::Tr({}, 505 CGI::td({}, 506 CGI::table({class=>"FormLayout"}, 507 CGI::Tr({}, 508 CGI::th({class=>"LeftHeader"}, "User ID:"), 509 CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)), 510 ), 511 CGI::Tr({}, 512 CGI::th({class=>"LeftHeader"}, "Password:"), 513 CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)), 514 ), 515 CGI::Tr({}, 516 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 517 CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)), 518 ), 519 ), 520 ), 521 CGI::td({}, 522 CGI::table({class=>"FormLayout"}, 523 CGI::Tr({}, 524 CGI::th({class=>"LeftHeader"}, "First Name:"), 525 CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)), 526 ), 527 CGI::Tr({}, 528 CGI::th({class=>"LeftHeader"}, "Last Name:"), 529 CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)), 530 ), 531 CGI::Tr({}, 532 CGI::th({class=>"LeftHeader"}, "Email Address:"), 533 CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)), 534 ), 535 ), 536 537 ), 538 )); 539 540 print CGI::p("To copy problem templates from an existing course, select the course below."); 541 542 print CGI::table({class=>"FormLayout"}, 543 CGI::Tr({}, 544 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 545 CGI::td( 546 CGI::popup_menu( 547 -name => "add_templates_course", 548 -values => [ "", @existingCourses ], 549 -default => $add_templates_course, 550 #-size => 10, 551 #-multiple => 0, 552 #-labels => \%courseLabels, 553 ), 554 555 ), 556 ), 557 ); 558 559 560 561 print CGI::p("Select a database layout below."); 562 print CGI::start_table({class=>"FormLayout"}); 563 564 my %dbLayout_buttons; 565 my $selected_dbLayout = defined $add_dbLayout ? $add_dbLayout : $ce->{dbLayout_order}[0]; 566 @dbLayout_buttons{@dbLayouts} = CGI::radio_group(-name=>"add_dbLayout",-values=>\@dbLayouts,-default=>$selected_dbLayout); 567 foreach my $dbLayout (@dbLayouts) { 568 my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout}) 569 ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout} 570 : "$dbLayout - no description provided in global.conf"; 571 print CGI::Tr({}, 572 CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}), 573 CGI::td($dbLayoutLabel), 574 ); 575 } 576 print CGI::end_table(); 577 print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course")); 578 579 print CGI::end_form(); 580 } 581 582 sub add_course_validate { 583 my ($self) = @_; 584 my $r = $self->r; 585 my $ce = $r->ce; 586 #my $db = $r->db; 587 #my $authz = $r->authz; 588 #my $urlpath = $r->urlpath; 589 590 591 my $add_courseID = trim_spaces( $r->param("add_courseID") ) || ""; 592 my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) || ""; 593 my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) || ""; 594 595 my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) || ""; 596 597 my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) || ""; 598 my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) || ""; 599 my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) || ""; 600 my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) || ""; 601 my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) || ""; 602 my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) || ""; 603 my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) || ""; 604 my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) || ""; 605 606 607 608 609 ###################### 610 611 my @errors; 612 613 if ($add_courseID eq "") { 614 push @errors, "You must specify a course ID."; 615 } 616 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 617 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 618 } 619 if (grep { $add_courseID eq $_ } listCourses($ce)) { 620 push @errors, "A course with ID $add_courseID already exists."; 621 } 622 #if ($add_courseTitle eq "") { 623 # push @errors, "You must specify a course title."; 624 #} 625 #if ($add_courseInstitution eq "") { 626 # push @errors, "You must specify an institution for this course."; 627 #} 628 629 if ($add_initial_userID ne "") { 630 if ($add_initial_password eq "") { 631 push @errors, "You must specify a password for the initial instructor."; 632 } 633 if ($add_initial_confirmPassword eq "") { 634 push @errors, "You must confirm the password for the initial instructor."; 635 } 636 if ($add_initial_password ne $add_initial_confirmPassword) { 637 push @errors, "The password and password confirmation for the instructor must match."; 638 } 639 if ($add_initial_firstName eq "") { 640 push @errors, "You must specify a first name for the initial instructor."; 641 } 642 if ($add_initial_lastName eq "") { 643 push @errors, "You must specify a last name for the initial instructor."; 644 } 645 if ($add_initial_email eq "") { 646 push @errors, "You must specify an email address for the initial instructor."; 647 } 648 } 649 650 if ($add_dbLayout eq "") { 651 push @errors, "You must select a database layout."; 652 } else { 653 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 654 # we used to check for layout-specific fields here, but there aren't any layouts that require them 655 # anymore. (in the future, we'll probably deal with this in layout-specific modules.) 656 } else { 657 push @errors, "The database layout $add_dbLayout doesn't exist."; 658 } 659 } 660 661 return @errors; 662 } 663 664 sub do_add_course { 665 my ($self) = @_; 666 my $r = $self->r; 667 my $ce = $r->ce; 668 my $db = $r->db; 669 my $authz = $r->authz; 670 my $urlpath = $r->urlpath; 671 672 my $add_courseID = trim_spaces( $r->param("add_courseID") ) || ""; 673 my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) || ""; 674 my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) || ""; 675 676 my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) || ""; 677 678 my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) || ""; 679 my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) || ""; 680 my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) || ""; 681 my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) || ""; 682 my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) || ""; 683 my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) || ""; 684 685 my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) || ""; 686 687 my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) || ""; 688 689 my $ce2 = new WeBWorK::CourseEnvironment({ 690 %WeBWorK::SeedCE, 691 courseName => $add_courseID, 692 }); 693 694 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 695 696 if ($add_initial_email ne "") { 697 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 698 # don't set feedbackRecipients -- this just gets in the way of the more 699 # intelligent "receive_recipients" method. 700 #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; 701 } 702 703 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 704 # below this line, we would grab values from getopt and put them in this hash 705 # but for now the hash can remain empty 706 my %dbOptions; 707 708 my @users; 709 710 # copy users from current (admin) course if desired 711 if ($add_admin_users ne "") { 712 foreach my $userID ($db->listUsers) { 713 if ($userID eq $add_initial_userID) { 714 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor."); 715 next; 716 } 717 my $User = $db->getUser($userID); 718 my $Password = $db->getPassword($userID); 719 my $PermissionLevel = $db->getPermissionLevel($userID); 720 push @users, [ $User, $Password, $PermissionLevel ] 721 if $authz->hasPermissions($userID,"create_and_delete_courses"); 722 #only transfer the "instructors" in the admin course classlist. 723 } 724 } 725 726 # add initial instructor if desired 727 if ($add_initial_userID ne "") { 728 my $User = $db->newUser( 729 user_id => $add_initial_userID, 730 first_name => $add_initial_firstName, 731 last_name => $add_initial_lastName, 732 student_id => $add_initial_userID, 733 email_address => $add_initial_email, 734 status => "C", 735 ); 736 my $Password = $db->newPassword( 737 user_id => $add_initial_userID, 738 password => cryptPassword($add_initial_password), 739 ); 740 my $PermissionLevel = $db->newPermissionLevel( 741 user_id => $add_initial_userID, 742 permission => "10", 743 ); 744 push @users, [ $User, $Password, $PermissionLevel ]; 745 } 746 747 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users; 748 749 my %optional_arguments; 750 if ($add_templates_course ne "") { 751 $optional_arguments{templatesFrom} = $add_templates_course; 752 } 753 754 eval { 755 addCourse( 756 courseID => $add_courseID, 757 ce => $ce2, 758 courseOptions => \%courseOptions, 759 dbOptions => \%dbOptions, 760 users => \@users, 761 %optional_arguments, 762 ); 763 }; 764 if ($@) { 765 my $error = $@; 766 print CGI::div({class=>"ResultsWithError"}, 767 CGI::p("An error occured while creating the course $add_courseID:"), 768 CGI::tt(CGI::escapeHTML($error)), 769 ); 770 # get rid of any partially built courses 771 # FIXME -- this is too fragile 772 unless ($error =~ /course exists/) { 773 eval { 774 deleteCourse( 775 courseID => $add_courseID, 776 ce => $ce2, 777 dbOptions => \%dbOptions, 778 ); 779 } 780 } 781 } else { 782 #log the action 783 writeLog($ce, "hosted_courses", join("\t", 784 "\tAdded", 785 ( defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)" ), 786 ( defined $add_courseTitle ? $add_courseTitle : "(no title specified)" ), 787 $add_courseID, 788 $add_initial_firstName, 789 $add_initial_lastName, 790 $add_initial_email, 791 )); 792 # add contact to admin course as student? 793 # FIXME -- should we do this? 794 if ($add_initial_userID ne "") { 795 my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact 796 my $User = $db->newUser( 797 user_id => $composite_id, # student id includes school name and contact 798 first_name => $add_initial_firstName, 799 last_name => $add_initial_lastName, 800 student_id => $add_initial_userID, 801 email_address => $add_initial_email, 802 status => "C", 803 ); 804 my $Password = $db->newPassword( 805 user_id => $composite_id, 806 password => cryptPassword($add_initial_password), 807 ); 808 my $PermissionLevel = $db->newPermissionLevel( 809 user_id => $composite_id, 810 permission => "0", 811 ); 812 # add contact to admin course as student 813 # or if this contact and course already exist in a dropped status 814 # change the student's status to enrolled 815 if (my $oldUser = $db->getUser($composite_id) ) { 816 warn "Replacing old data for $composite_id status: ". $oldUser->status; 817 $db->deleteUser($composite_id); 818 } 819 eval { $db->addUser($User) }; warn $@ if $@; 820 eval { $db->addPassword($Password) }; warn $@ if $@; 821 eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; 822 } 823 print CGI::div({class=>"ResultsWithoutError"}, 824 CGI::p("Successfully created the course $add_courseID"), 825 ); 826 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 827 courseID => $add_courseID); 828 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 829 print CGI::div({style=>"text-align: center"}, 830 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 831 ); 832 } 833 834 835 } 836 837 ################################################################################ 838 839 sub rename_course_form { 840 my ($self) = @_; 841 my $r = $self->r; 842 my $ce = $r->ce; 843 #my $db = $r->db; 844 #my $authz = $r->authz; 845 #my $urlpath = $r->urlpath; 846 847 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 848 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 849 850 my @courseIDs = listCourses($ce); 851 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; 852 853 my %courseLabels; # records... heh. 854 foreach my $courseID (@courseIDs) { 855 my $tempCE = new WeBWorK::CourseEnvironment({ 856 %WeBWorK::SeedCE, 857 courseName => $courseID, 858 }); 859 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 860 } 861 862 print CGI::h2("Rename Course"); 863 864 print CGI::start_form(-method=>"POST", -action=>$r->uri); 865 print $self->hidden_authen_fields; 866 print $self->hidden_fields("subDisplay"); 867 868 print CGI::p("Select a course to rename."); 869 870 print CGI::table({class=>"FormLayout"}, 871 CGI::Tr({}, 872 CGI::th({class=>"LeftHeader"}, "Course Name:"), 873 CGI::td( 874 CGI::scrolling_list( 875 -name => "rename_oldCourseID", 876 -values => \@courseIDs, 877 -default => $rename_oldCourseID, 878 -size => 10, 879 -multiple => 0, 880 -labels => \%courseLabels, 881 ), 882 ), 883 ), 884 CGI::Tr({}, 885 CGI::th({class=>"LeftHeader"}, "New Name:"), 886 CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)), 887 ), 888 ); 889 890 print CGI::end_table(); 891 892 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course")); 893 894 print CGI::end_form(); 895 } 896 sub rename_course_confirm { 897 898 my ($self) = @_; 899 my $r = $self->r; 900 my $ce = $r->ce; 901 #my $db = $r->db; 902 #my $authz = $r->authz; 903 #my $urlpath = $r->urlpath; 904 905 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 906 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 907 908 my $ce2 = new WeBWorK::CourseEnvironment({ 909 %WeBWorK::SeedCE, 910 courseName => $rename_oldCourseID, 911 }); 912 ############################################################################# 913 # Check database 914 ############################################################################# 915 916 my ($tables_ok,$dbStatus); 917 if ($ce2->{dbLayoutName} ) { 918 my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2); 919 ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); 920 if ($r->param("upgrade_course_tables")) { 921 my @schema_table_names = keys %$dbStatus; # update tables missing from database; 922 my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names; 923 my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names; 924 my $msg = $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create]); 925 foreach my $table_name (@tables_to_alter) { 926 $msg .= $CIchecker->updateTableFields($rename_oldCourseID, $table_name); 927 } 928 print CGI::p({-style=>'color:green; font-weight:bold'}, $msg); 929 930 } 931 ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); 932 933 934 # print db status 935 936 my %msg =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"), 937 WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"), 938 WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," Table is ok "), 939 WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "), 940 ); 941 my %msg2 =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," missing in database"), 942 WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," missing in schema"), 943 WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," is ok "), 944 WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "), 945 ); 946 my $all_tables_ok=1; 947 my $extra_database_tables=0; 948 my $extra_database_fields=0; 949 my $str=CGI::h4("Report on database structure for course $rename_oldCourseID:").CGI::br(); 950 foreach my $table (sort keys %$dbStatus) { 951 my $table_status = $dbStatus->{$table}->[0]; 952 $str .= CGI::b($table) . $msg{ $table_status } . CGI::br(); 953 954 CASE: { 955 $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B 956 && do{ last CASE; 957 }; 958 $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A 959 && do{ 960 $all_tables_ok = 0; last CASE; 961 }; 962 $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B 963 && do{ 964 $extra_database_tables = 1; last CASE; 965 }; 966 $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B 967 && do{ 968 my %fieldInfo = %{ $dbStatus->{$table}->[1] }; 969 foreach my $key (keys %fieldInfo) { 970 my $field_status = $fieldInfo{$key}->[0]; 971 CASE2: { 972 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B 973 && do{ 974 $extra_database_fields = 1; last CASE2; 975 }; 976 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A 977 && do{ 978 $all_tables_ok=0; last CASE2; 979 }; 980 } 981 $str .= CGI::br()."\n Field $key => ". $msg2{$field_status }; 982 } 983 }; 984 } 985 $str.=CGI::br(); 986 987 } 988 ############################################################################# 989 # Report on databases 990 ############################################################################# 991 992 print CGI::p($str); 993 if ($extra_database_tables) { 994 print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema. 995 They can only be removed manually from the database. They will not be renamed."); 996 } 997 if ($extra_database_fields) { 998 print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields which are not defined in the schema for at least one table. 999 They can only be removed manually from the database."); 1000 } 1001 if ($all_tables_ok) { 1002 print CGI::p({-style=>'color:green; font-weight:bold'},"Course $rename_oldCourseID database is in order"); 1003 } else { 1004 print CGI::p({-style=>'color:red; font-weight:bold'}, "Course $rename_oldCourseID databases must be updated before renaming this course."); 1005 } 1006 1007 ############################################################################# 1008 # Check directories 1009 ############################################################################# 1010 1011 1012 my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2); 1013 my $style = ($directories_ok)?"color:green" : "color:red"; 1014 print CGI::h2("Directory structure"), CGI::p($str2), 1015 ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") : 1016 CGI::p({style=>$style},"Directory structure is missing directories 1017 or the webserver lacks sufficient privileges."); 1018 1019 ############################################################################# 1020 # Print form for choosing next action. 1021 ############################################################################# 1022 1023 1024 1025 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1026 print $self->hidden_authen_fields; 1027 print $self->hidden_fields("subDisplay"); 1028 print $self->hidden_fields(qw/rename_oldCourseID rename_newCourseID/); 1029 # grab some values we'll need 1030 # fail if the source course does not exist 1031 1032 1033 1034 if ($all_tables_ok && $directories_ok ) { # no missing tables or missing fields or directories 1035 print CGI::p({style=>"text-align: center"}, 1036 CGI::submit(-name=>"decline_rename_course", -value=>"Don't rename"), 1037 " ", 1038 CGI::submit(-name=>"confirm_rename_course", -value=>"Rename") , 1039 ); 1040 } elsif( $directories_ok ) { 1041 print CGI::p({style=>"text-align: center"}, 1042 CGI::submit(-name => "decline_rename_course", -value => "Don't rename"), 1043 " ", 1044 CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"), 1045 ); 1046 } else { 1047 print CGI::p({style=>"text-align: center"}, 1048 CGI::submit(-name => "decline_rename_course", -value => "Don't rename"), 1049 CGI::br(),"Directory structure needs to be repaired manually before renaming." 1050 ); 1051 } 1052 } 1053 } 1054 sub rename_course_validate { 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 $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 1063 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 1064 1065 my @errors; 1066 1067 if ($rename_oldCourseID eq "") { 1068 push @errors, "You must select a course to rename."; 1069 } 1070 if ($rename_newCourseID eq "") { 1071 push @errors, "You must specify a new name for the course."; 1072 } 1073 if ($rename_oldCourseID eq $rename_newCourseID) { 1074 push @errors, "Can't rename to the same name."; 1075 } 1076 unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 1077 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 1078 } 1079 if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { 1080 push @errors, "A course with ID $rename_newCourseID already exists."; 1081 } 1082 1083 my $ce2 = new WeBWorK::CourseEnvironment({ 1084 %WeBWorK::SeedCE, 1085 courseName => $rename_oldCourseID, 1086 }); 1087 1088 return @errors; 1089 } 1090 1091 sub do_rename_course { 1092 my ($self) = @_; 1093 my $r = $self->r; 1094 my $ce = $r->ce; 1095 my $db = $r->db; 1096 #my $authz = $r->authz; 1097 my $urlpath = $r->urlpath; 1098 1099 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 1100 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 1101 1102 my $ce2 = new WeBWorK::CourseEnvironment({ 1103 %WeBWorK::SeedCE, 1104 courseName => $rename_oldCourseID, 1105 }); 1106 1107 my $dbLayoutName = $ce->{dbLayoutName}; 1108 1109 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 1110 # below this line, we would grab values from getopt and put them in this hash 1111 # but for now the hash can remain empty 1112 my %dbOptions; 1113 1114 eval { 1115 renameCourse( 1116 courseID => $rename_oldCourseID, 1117 ce => $ce2, 1118 dbOptions => \%dbOptions, 1119 newCourseID => $rename_newCourseID, 1120 ); 1121 }; 1122 if ($@) { 1123 my $error = $@; 1124 print CGI::div({class=>"ResultsWithError"}, 1125 CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"), 1126 CGI::tt(CGI::escapeHTML($error)), 1127 ); 1128 } else { 1129 print CGI::div({class=>"ResultsWithoutError"}, 1130 CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"), 1131 ); 1132 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 1133 courseID => $rename_newCourseID); 1134 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 1135 print CGI::div({style=>"text-align: center"}, 1136 CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"), 1137 ); 1138 } 1139 } 1140 1141 ################################################################################ 1142 1143 sub delete_course_form { 1144 my ($self) = @_; 1145 my $r = $self->r; 1146 my $ce = $r->ce; 1147 #my $db = $r->db; 1148 #my $authz = $r->authz; 1149 #my $urlpath = $r->urlpath; 1150 1151 my $delete_courseID = $r->param("delete_courseID") || ""; 1152 1153 my @courseIDs = listCourses($ce); 1154 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1155 1156 my %courseLabels; # records... heh. 1157 foreach my $courseID (@courseIDs) { 1158 my $tempCE = new WeBWorK::CourseEnvironment({ 1159 %WeBWorK::SeedCE, 1160 courseName => $courseID, 1161 }); 1162 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1163 } 1164 1165 print CGI::h2("Delete Course"); 1166 1167 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1168 print $self->hidden_authen_fields; 1169 print $self->hidden_fields("subDisplay"); 1170 1171 print CGI::p("Select a course to delete."); 1172 1173 print CGI::table({class=>"FormLayout"}, 1174 CGI::Tr({}, 1175 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1176 CGI::td( 1177 CGI::scrolling_list( 1178 -name => "delete_courseID", 1179 -values => \@courseIDs, 1180 -default => $delete_courseID, 1181 -size => 10, 1182 -multiple => 0, 1183 -labels => \%courseLabels, 1184 ), 1185 ), 1186 ), 1187 ); 1188 1189 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course")); 1190 1191 print CGI::end_form(); 1192 } 1193 1194 sub delete_course_validate { 1195 my ($self) = @_; 1196 my $r = $self->r; 1197 my $ce = $r->ce; 1198 #my $db = $r->db; 1199 #my $authz = $r->authz; 1200 my $urlpath = $r->urlpath; 1201 1202 my $delete_courseID = $r->param("delete_courseID") || ""; 1203 1204 my @errors; 1205 1206 if ($delete_courseID eq "") { 1207 push @errors, "You must specify a course name."; 1208 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 1209 push @errors, "You cannot delete the course you are currently using."; 1210 } 1211 1212 my $ce2 = new WeBWorK::CourseEnvironment({ 1213 %WeBWorK::SeedCE, 1214 courseName => $delete_courseID, 1215 }); 1216 1217 return @errors; 1218 } 1219 1220 sub delete_course_confirm { 1221 my ($self) = @_; 1222 my $r = $self->r; 1223 my $ce = $r->ce; 1224 #my $db = $r->db; 1225 #my $authz = $r->authz; 1226 #my $urlpath = $r->urlpath; 1227 1228 print CGI::h2("Delete Course"); 1229 1230 my $delete_courseID = $r->param("delete_courseID") || ""; 1231 1232 my $ce2 = new WeBWorK::CourseEnvironment({ 1233 %WeBWorK::SeedCE, 1234 courseName => $delete_courseID, 1235 }); 1236 1237 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1238 . "? All course files and data will be destroyed. There is no undo available."); 1239 1240 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1241 print $self->hidden_authen_fields; 1242 print $self->hidden_fields("subDisplay"); 1243 print $self->hidden_fields(qw/delete_courseID/); 1244 1245 print CGI::p({style=>"text-align: center"}, 1246 CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"), 1247 " ", 1248 CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"), 1249 ); 1250 1251 print CGI::end_form(); 1252 } 1253 1254 sub do_delete_course { 1255 my ($self) = @_; 1256 my $r = $self->r; 1257 my $ce = $r->ce; 1258 my $db = $r->db; 1259 #my $authz = $r->authz; 1260 #my $urlpath = $r->urlpath; 1261 1262 my $delete_courseID = $r->param("delete_courseID") || ""; 1263 1264 my $ce2 = new WeBWorK::CourseEnvironment({ 1265 %WeBWorK::SeedCE, 1266 courseName => $delete_courseID, 1267 }); 1268 1269 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 1270 # below this line, we would grab values from getopt and put them in this hash 1271 # but for now the hash can remain empty 1272 my %dbOptions; 1273 1274 eval { 1275 deleteCourse( 1276 courseID => $delete_courseID, 1277 ce => $ce2, 1278 dbOptions => \%dbOptions, 1279 ); 1280 }; 1281 1282 if ($@) { 1283 my $error = $@; 1284 print CGI::div({class=>"ResultsWithError"}, 1285 CGI::p("An error occured while deleting the course $delete_courseID:"), 1286 CGI::tt(CGI::escapeHTML($error)), 1287 ); 1288 } else { 1289 # mark the contact person in the admin course as dropped. 1290 # find the contact person for the course by searching the admin classlist. 1291 my @contacts = grep /_$delete_courseID$/, $db->listUsers; 1292 if (@contacts) { 1293 die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1; 1294 #warn "contacts", join(" ", @contacts); 1295 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1296 my $composite_id = $contacts[0]; 1297 1298 # mark the contact person as dropped. 1299 my $User = $db->getUser($composite_id); 1300 my $status_name = 'Drop'; 1301 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 1302 $User->status($status_value); 1303 $db->putUser($User); 1304 } 1305 1306 print CGI::div({class=>"ResultsWithoutError"}, 1307 CGI::p("Successfully deleted the course $delete_courseID."), 1308 ); 1309 writeLog($ce, "hosted_courses", join("\t", 1310 "\tDeleted", 1311 "", 1312 "", 1313 $delete_courseID, 1314 )); 1315 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1316 print $self->hidden_authen_fields; 1317 print $self->hidden_fields("subDisplay"); 1318 1319 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),); 1320 1321 print CGI::end_form(); 1322 } 1323 } 1324 1325 ################################################################################ 1326 1327 sub export_database_form { 1328 my ($self) = @_; 1329 my $r = $self->r; 1330 my $ce = $r->ce; 1331 #my $db = $r->db; 1332 #my $authz = $r->authz; 1333 #my $urlpath = $r->urlpath; 1334 1335 my @tables = keys %{$ce->{dbLayout}}; 1336 1337 my $export_courseID = $r->param("export_courseID") || ""; 1338 my @export_tables = $r->param("export_tables"); 1339 1340 @export_tables = @tables unless @export_tables; 1341 1342 my @courseIDs = listCourses($ce); 1343 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1344 1345 my %courseLabels; # records... heh. 1346 foreach my $courseID (@courseIDs) { 1347 my $tempCE = new WeBWorK::CourseEnvironment({ 1348 %WeBWorK::SeedCE, 1349 courseName => $courseID, 1350 }); 1351 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1352 } 1353 1354 print CGI::h2("Export Database"); 1355 1356 print CGI::p(IMPORT_EXPORT_WARNING); 1357 1358 print CGI::start_form(-method=>"GET", -action=>$r->uri); 1359 print $self->hidden_authen_fields; 1360 print $self->hidden_fields("subDisplay"); 1361 1362 print CGI::p({},"Select a course to export the course's database. Please note 1363 that exporting can take a very long time for a large course. If you have 1364 shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), " 1365 utility instead."); 1366 1367 print CGI::table({class=>"FormLayout"}, 1368 CGI::Tr({}, 1369 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1370 CGI::td( 1371 CGI::scrolling_list( 1372 -name => "export_courseID", 1373 -values => \@courseIDs, 1374 -default => $export_courseID, 1375 -size => 10, 1376 -multiple => 1, 1377 -labels => \%courseLabels, 1378 ), 1379 ), 1380 ), 1381 CGI::Tr({}, 1382 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1383 CGI::td({}, 1384 CGI::checkbox_group( 1385 -name => "export_tables", 1386 -values => \@tables, 1387 -default => \@export_tables, 1388 -linebreak => 1, 1389 ), 1390 ), 1391 ), 1392 ); 1393 1394 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database")); 1395 1396 print CGI::end_form(); 1397 } 1398 1399 sub export_database_validate { 1400 my ($self) = @_; 1401 my $r = $self->r; 1402 #my $ce = $r->ce; 1403 #my $db = $r->db; 1404 #my $authz = $r->authz; 1405 #my $urlpath = $r->urlpath; 1406 1407 my @export_courseID = $r->param("export_courseID") || (); 1408 my @export_tables = $r->param("export_tables"); 1409 1410 my @errors; 1411 1412 unless ( @export_courseID) { 1413 push @errors, "You must specify at least one course name."; 1414 } 1415 1416 unless (@export_tables) { 1417 push @errors, "You must specify at least one table to export."; 1418 } 1419 1420 return @errors; 1421 } 1422 1423 sub do_export_database { 1424 my ($self) = @_; 1425 my $r = $self->r; 1426 my $ce = $r->ce; 1427 #my $db = $r->db; 1428 #my $authz = $r->authz; 1429 my $urlpath = $r->urlpath; 1430 1431 my @export_courseID = $r->param("export_courseID"); 1432 my @export_tables = $r->param("export_tables"); 1433 1434 foreach my $export_courseID (@export_courseID) { 1435 1436 my $ce2 = new WeBWorK::CourseEnvironment({ 1437 %WeBWorK::SeedCE, 1438 courseName => $export_courseID, 1439 }); 1440 1441 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1442 1443 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1444 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1445 # export to the admin/templates directory 1446 my $exportFileName = "$export_courseID.exported.xml"; 1447 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName"; 1448 # get a unique name 1449 my $number =1; 1450 while (-e "$exportFilePath.$number.gz") { 1451 $number++; 1452 last if $number>9; 1453 } 1454 if ($number<=9 ) { 1455 $exportFilePath = "$exportFilePath.$number"; 1456 $exportFileName = "$exportFileName.$number"; 1457 } else { 1458 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please 1459 remove some of these files.")); 1460 $exportFilePath = "$exportFilePath.999"; 1461 $exportFileName = "$exportFileName.999"; 1462 } 1463 1464 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath"; 1465 1466 my @errors; 1467 eval { 1468 @errors = dbExport( 1469 db => $db2, 1470 #xml => $fh, 1471 xml => $outputFileHandle, 1472 tables => \@export_tables, 1473 ); 1474 }; 1475 1476 $outputFileHandle->close(); 1477 1478 my $gzipMessage = system($ce->{externalPrograms}{gzip}, $exportFilePath); 1479 if ( !$gzipMessage ) { 1480 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gz. 1481 You may download it with the file manager.")); 1482 } else { 1483 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath")); 1484 } 1485 unlink $exportFilePath; 1486 } # end export of one course 1487 #push @errors, "Fatal exception: $@" if $@; 1488 # 1489 #if (@errors) { 1490 # print CGI::div({class=>"ResultsWithError"}, 1491 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1492 # CGI::ul(CGI::li(\@errors)), 1493 # ); 1494 #} else { 1495 # print CGI::div({class=>"ResultsWithoutError"}, 1496 # CGI::p("Export succeeded."), 1497 # ); 1498 # 1499 # print CGI::div({style=>"text-align: center"}, 1500 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1501 # ); 1502 #} 1503 } 1504 1505 ################################################################################ 1506 1507 sub import_database_form { 1508 my ($self) = @_; 1509 my $r = $self->r; 1510 my $ce = $r->ce; 1511 #my $db = $r->db; 1512 #my $authz = $r->authz; 1513 #my $urlpath = $r->urlpath; 1514 1515 my @tables = keys %{$ce->{dbLayout}}; 1516 1517 my $import_file = $r->param("import_file") || ""; 1518 my $import_courseID = $r->param("import_courseID") || ""; 1519 my @import_tables = $r->param("import_tables"); 1520 my $import_conflict = $r->param("import_conflict") || "skip"; 1521 1522 @import_tables = @tables unless @import_tables; 1523 1524 my @courseIDs = listCourses($ce); 1525 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1526 1527 1528 my %courseLabels; # records... heh. 1529 foreach my $courseID (@courseIDs) { 1530 my $tempCE = new WeBWorK::CourseEnvironment({ 1531 %WeBWorK::SeedCE, 1532 courseName => $courseID, 1533 }); 1534 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1535 } 1536 1537 # find databases: 1538 my $templatesDir = $ce->{courseDirs}->{templates}; 1539 my $exempt_dirs = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); 1540 1541 my @databaseFiles = listFilesRecursive( 1542 $templatesDir, 1543 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!! 1544 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories 1545 0, # match against file name only 1546 1, # prune against path relative to $templatesDir 1547 ); 1548 1549 my %databaseLabels = map { ($_ => $_) } @databaseFiles; 1550 1551 ####### 1552 1553 print CGI::h2("Import Database"); 1554 1555 print CGI::p(IMPORT_EXPORT_WARNING); 1556 1557 print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART); 1558 print $self->hidden_authen_fields; 1559 print $self->hidden_fields("subDisplay"); 1560 1561 print CGI::table({class=>"FormLayout"}, 1562 CGI::Tr({}, 1563 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1564 CGI::td( 1565 CGI::scrolling_list( 1566 -name => "import_file", 1567 -values => \@databaseFiles, 1568 -default => undef, 1569 -size => 10, 1570 -multiple => 0, 1571 -labels => \%databaseLabels, 1572 ), 1573 1574 ) 1575 ), 1576 CGI::Tr({}, 1577 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1578 CGI::td( 1579 CGI::checkbox_group( 1580 -name => "import_tables", 1581 -values => \@tables, 1582 -default => \@import_tables, 1583 -linebreak => 1, 1584 ), 1585 ), 1586 ), 1587 CGI::Tr({}, 1588 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1589 CGI::td( 1590 CGI::scrolling_list( 1591 -name => "import_courseID", 1592 -values => \@courseIDs, 1593 -default => $import_courseID, 1594 -size => 10, 1595 -multiple => 0, 1596 -labels => \%courseLabels, 1597 ), 1598 ), 1599 ), 1600 CGI::Tr({}, 1601 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1602 CGI::td( 1603 CGI::radio_group( 1604 -name => "import_conflict", 1605 -values => [qw/skip replace/], 1606 -default => $import_conflict, 1607 -linebreak=>'true', 1608 -labels => { 1609 skip => "Skip duplicate records", 1610 replace => "Replace duplicate records", 1611 }, 1612 ), 1613 ), 1614 ), 1615 ); 1616 1617 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database")); 1618 1619 print CGI::end_form(); 1620 } 1621 1622 sub import_database_validate { 1623 my ($self) = @_; 1624 my $r = $self->r; 1625 #my $ce = $r->ce; 1626 #my $db = $r->db; 1627 #my $authz = $r->authz; 1628 #my $urlpath = $r->urlpath; 1629 1630 my $import_file = $r->param("import_file") || ""; 1631 my $import_courseID = $r->param("import_courseID") || ""; 1632 my @import_tables = $r->param("import_tables"); 1633 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1634 1635 my @errors; 1636 1637 if ($import_file eq "") { 1638 push @errors, "You must specify a database file to import."; 1639 } 1640 1641 if ($import_courseID eq "") { 1642 push @errors, "You must specify a course name."; 1643 } 1644 1645 unless (@import_tables) { 1646 push @errors, "You must specify at least one table to import."; 1647 } 1648 1649 return @errors; 1650 } 1651 1652 sub do_import_database { 1653 my ($self) = @_; 1654 my $r = $self->r; 1655 my $ce = $r->ce; 1656 #my $db = $r->db; 1657 #my $authz = $r->authz; 1658 my $urlpath = $r->urlpath; 1659 1660 my $import_file = $r->param("import_file"); 1661 my $import_courseID = $r->param("import_courseID"); 1662 my @import_tables = $r->param("import_tables"); 1663 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1664 1665 my $ce2 = new WeBWorK::CourseEnvironment({ 1666 %WeBWorK::SeedCE, 1667 courseName => $import_courseID, 1668 }); 1669 1670 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1671 1672 # locate file 1673 my $templateDir = $ce->{courseDirs}->{templates}; 1674 my $filePath = "$templateDir/$import_file"; 1675 1676 my $gunzipMessage = system( 'gunzip', $filePath); 1677 #FIXME 1678 #warn "gunzip ", $gunzipMessage; 1679 $filePath =~ s/\.gz$//; 1680 #warn "new file path is $filePath"; 1681 my $fileHandle = new IO::File("<$filePath"); 1682 # retrieve upload from upload cache 1683 # my ($id, $hash) = split /\s+/, $import_file; 1684 # my $upload = WeBWorK::Upload->retrieve($id, $hash, 1685 # dir => $ce->{webworkDirs}->{uploadCache} 1686 # ); 1687 1688 my @errors; 1689 1690 eval { 1691 @errors = dbImport( 1692 db => $db2, 1693 # xml => $upload->fileHandle, 1694 xml => $fileHandle, 1695 tables => \@import_tables, 1696 conflict => $import_conflict, 1697 ); 1698 }; 1699 1700 push @errors, "Fatal exception: $@" if $@; 1701 push @errors, $gunzipMessage if $gunzipMessage; 1702 1703 if (@errors) { 1704 print CGI::div({class=>"ResultsWithError"}, 1705 CGI::p("An error occured while importing the database of course $import_courseID:"), 1706 CGI::ul(CGI::li(\@errors)), 1707 ); 1708 } else { 1709 print CGI::div({class=>"ResultsWithoutError"}, 1710 CGI::p("Import succeeded."), 1711 ); 1712 } 1713 } 1714 ################################################################################ 1715 1716 sub archive_course_form { 1717 my ($self) = @_; 1718 my $r = $self->r; 1719 my $ce = $r->ce; 1720 #my $db = $r->db; 1721 #my $authz = $r->authz; 1722 #my $urlpath = $r->urlpath; 1723 1724 my $archive_courseID = $r->param("archive_courseID") || ""; 1725 1726 my @courseIDs = listCourses($ce); 1727 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1728 1729 my %courseLabels; # records... heh. 1730 foreach my $courseID (@courseIDs) { 1731 my $tempCE = new WeBWorK::CourseEnvironment({ 1732 %WeBWorK::SeedCE, 1733 courseName => $courseID, 1734 }); 1735 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1736 } 1737 1738 print CGI::h2("archive Course"); 1739 1740 print CGI::p( 1741 "Creates a gzipped tar archive (.tar.gz) of a course in the WeBWorK 1742 courses directory. Before archiving, the course database is dumped into 1743 a subdirectory of the course's DATA directory. Currently the archive 1744 facility is only available for mysql databases. It depends on the 1745 mysqldump application." 1746 ); 1747 1748 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1749 print $self->hidden_authen_fields; 1750 print $self->hidden_fields("subDisplay"); 1751 1752 print CGI::p("Select a course to archive."); 1753 1754 print CGI::table({class=>"FormLayout"}, 1755 CGI::Tr({}, 1756 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1757 CGI::td( 1758 CGI::scrolling_list( 1759 -name => "archive_courseID", 1760 -values => \@courseIDs, 1761 -default => $archive_courseID, 1762 -size => 10, 1763 -multiple => 0, 1764 -labels => \%courseLabels, 1765 ), 1766 ), 1767 1768 ), 1769 CGI::Tr({}, 1770 CGI::th({class=>"LeftHeader"}, "Delete course:"), 1771 CGI::td({-style=>'color:red'}, CGI::checkbox({ 1772 -name=>'delete_course', 1773 -checked=>0, 1774 -value => 1, 1775 -label =>'Delete course after archiving. Caution there is no undo!', 1776 }, 1777 ), 1778 ), 1779 ) 1780 ); 1781 1782 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course", -value=>"archive Course")); 1783 1784 print CGI::end_form(); 1785 } 1786 1787 sub archive_course_validate { 1788 my ($self) = @_; 1789 my $r = $self->r; 1790 my $ce = $r->ce; 1791 #my $db = $r->db; 1792 #my $authz = $r->authz; 1793 my $urlpath = $r->urlpath; 1794 1795 my $archive_courseID = $r->param("archive_courseID") || ""; 1796 1797 my @errors; 1798 1799 if ($archive_courseID eq "") { 1800 push @errors, "You must specify a course name."; 1801 } elsif ($archive_courseID eq $urlpath->arg("courseID")) { 1802 push @errors, "You cannot archive the course you are currently using."; 1803 } 1804 1805 #my $ce2 = new WeBWorK::CourseEnvironment({ 1806 # %WeBWorK::SeedCE, 1807 # courseName => $archive_courseID, 1808 #}); 1809 1810 return @errors; 1811 } 1812 1813 sub archive_course_confirm { 1814 my ($self) = @_; 1815 my $r = $self->r; 1816 my $ce = $r->ce; 1817 #my $db = $r->db; 1818 #my $authz = $r->authz; 1819 #my $urlpath = $r->urlpath; 1820 1821 print CGI::h2("archive Course"); 1822 1823 my $archive_courseID = $r->param("archive_courseID") || ""; 1824 my $delete_course_flag = $r->param("delete_course") || ""; 1825 1826 my $ce2 = new WeBWorK::CourseEnvironment({ 1827 %WeBWorK::SeedCE, 1828 courseName => $archive_courseID, 1829 }); 1830 1831 1832 my ($tables_ok,$dbStatus); 1833 ############################################################################# 1834 # Check database 1835 ############################################################################# 1836 my %missing_fields; 1837 if ($ce2->{dbLayoutName} ) { 1838 my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2); 1839 ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID); 1840 if ($r->param("upgrade_course_tables")) { 1841 my @schema_table_names = keys %$dbStatus; # update tables missing from database; 1842 my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names; 1843 my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names; 1844 my $msg = $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create]); 1845 foreach my $table_name (@tables_to_alter) { 1846 $msg .= $CIchecker->updateTableFields($archive_courseID, $table_name); 1847 } 1848 print CGI::p({-style=>'color:green; font-weight:bold'}, $msg); 1849 } 1850 if ($r->param("upgrade_course_tables") ) { 1851 1852 $CIchecker -> updateCourseDirectories(); # needs more error messages 1853 1854 1855 1856 } 1857 ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID); 1858 1859 1860 # print db status 1861 1862 my %msg =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"), 1863 WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"), 1864 WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," Table is ok "), 1865 WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "), 1866 ); 1867 my %msg2 =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," missing in database"), 1868 WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," missing in schema"), 1869 WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," is ok "), 1870 WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "), 1871 ); 1872 my $all_tables_ok=1; 1873 my $extra_database_tables=0; 1874 my $extra_database_fields=0; 1875 my $str=CGI::h4("Report on database structure for course $archive_courseID:").CGI::br(); 1876 foreach my $table (sort keys %$dbStatus) { 1877 my $table_status = $dbStatus->{$table}->[0]; 1878 $str .= CGI::b($table) . $msg{ $table_status } . CGI::br(); 1879 1880 CASE: { 1881 $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B 1882 && do{ last CASE; 1883 }; 1884 $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A 1885 && do{ 1886 $all_tables_ok = 0; last CASE; 1887 }; 1888 $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B 1889 && do{ 1890 $extra_database_tables = 1; last CASE; 1891 }; 1892 $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B 1893 && do{ 1894 my %fieldInfo = %{ $dbStatus->{$table}->[1] }; 1895 foreach my $key (keys %fieldInfo) { 1896 my $field_status = $fieldInfo{$key}->[0]; 1897 CASE2: { 1898 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B 1899 && do{ 1900 $extra_database_fields = 1; last CASE2; 1901 }; 1902 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A 1903 && do{ 1904 $all_tables_ok=0; last CASE2; 1905 }; 1906 } 1907 $str .= CGI::br()."\n Field $key => ". $msg2{$field_status }; 1908 } 1909 }; 1910 } 1911 $str.=CGI::br(); 1912 1913 } 1914 ############################################################################# 1915 # Report on databases 1916 ############################################################################# 1917 1918 print CGI::p($str); 1919 if ($extra_database_tables) { 1920 print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema. 1921 They can only be removed manually from the database."); 1922 } 1923 if ($extra_database_fields) { 1924 print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields which are not defined in the schema for at least one table. 1925 They can only be removed manually from the database."); 1926 } 1927 if ($all_tables_ok) { 1928 print CGI::p({-style=>'color:green; font-weight:bold'},"Course $archive_courseID database is in order"); 1929 print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ". 1930 CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag; 1931 } else { 1932 print CGI::p({-style=>'color:red; font-weight:bold'}, "There are tables or fields missing from the 1933 database. The database 1934 must be upgraded before archiving this course." 1935 ); 1936 } 1937 ############################################################################# 1938 # Check directories 1939 ############################################################################# 1940 1941 1942 my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories(); 1943 my $style = ($directories_ok)?"color:green" : "color:red"; 1944 print CGI::h2("Directory structure"), CGI::p($str2), 1945 ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") : 1946 CGI::p({style=>$style},"Directory structure is missing directories 1947 or the webserver lacks sufficient privileges."); 1948 1949 1950 1951 1952 ############################################################################# 1953 # Print form for choosing next action. 1954 ############################################################################# 1955 1956 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1957 print $self->hidden_authen_fields; 1958 print $self->hidden_fields("subDisplay"); 1959 print $self->hidden_fields(qw/archive_courseID delete_course/); 1960 # grab some values we'll need 1961 my $course_dir = $ce2->{courseDirs}{root}; 1962 my $archive_path = $ce2->{webworkDirs}{courses} . "/$archive_courseID.tar.gz"; 1963 # fail if the source course does not exist 1964 unless (-e $course_dir) { 1965 print CGI::p( "$archive_courseID: The directory for the course not found."); 1966 } 1967 1968 if ($all_tables_ok && $directories_ok ) { # no missing fields 1969 # Warn about overwriting an existing archive 1970 if (-e $archive_path and -w $archive_path) { 1971 print CGI::p({-style=>'color:red; font-weight:bold'},"The course '$archive_courseID' has already been archived at '$archive_path'. 1972 This earlier archive will be erased. This cannot be undone."); 1973 } 1974 # archive execute button 1975 print CGI::p({style=>"text-align: center"}, 1976 CGI::submit(-name=>"decline_archive_course", -value=>"Don't archive"), 1977 " ", 1978 CGI::submit(-name=>"confirm_archive_course", -value=>"archive") , 1979 ); 1980 } elsif( $directories_ok) { 1981 print CGI::p({style=>"text-align: center"}, 1982 CGI::submit(-name => "decline_archive_course", -value => "Don't archive"), 1983 " ", 1984 CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"), 1985 ); 1986 } else { 1987 print CGI::p({style=>"text-align: center"}, 1988 CGI::br(), 1989 "Directory structure needs to be repaired manually before archiving.",CGI::br(), 1990 CGI::submit(-name => "decline_archive_course", -value => "Don't archive"), 1991 CGI::submit(-name => "upgrade_course_tables", -value => "Attempt to upgrade directories"), 1992 ); 1993 1994 } 1995 print CGI::end_form(); 1996 } else { 1997 print CGI::p({-style=>'color:red; font-weight:bold'},"Unable to find database layout for $archive_courseID"); 1998 } 1999 } 2000 2001 sub do_archive_course { 2002 my ($self) = @_; 2003 my $r = $self->r; 2004 my $ce = $r->ce; 2005 my $db = $r->db; 2006 #my $authz = $r->authz; 2007 #my $urlpath = $r->urlpath; 2008 2009 my $archive_courseID = $r->param("archive_courseID") || ""; 2010 my $delete_course_flag = $r->param("delete_course") || ""; 2011 2012 my $ce2 = new WeBWorK::CourseEnvironment({ 2013 %WeBWorK::SeedCE, 2014 courseName => $archive_courseID, 2015 }); 2016 2017 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 2018 # below this line, we would grab values from getopt and put them in this hash 2019 # but for now the hash can remain empty 2020 my %dbOptions; 2021 2022 eval { 2023 archiveCourse( 2024 courseID => $archive_courseID, 2025 ce => $ce2, 2026 dbOptions => \%dbOptions, 2027 ); 2028 }; 2029 2030 if ($@) { 2031 my $error = $@; 2032 print CGI::div({class=>"ResultsWithError"}, 2033 CGI::p("An error occured while archiving the course $archive_courseID:"), 2034 CGI::tt(CGI::escapeHTML($error)), 2035 ); 2036 } else { 2037 print CGI::div({class=>"ResultsWithoutError"}, 2038 CGI::p("Successfully archived the course $archive_courseID"), 2039 ); 2040 writeLog($ce, "hosted_courses", join("\t", 2041 "\tarchived", 2042 "", 2043 "", 2044 $archive_courseID, 2045 )); 2046 2047 if ($delete_course_flag) { 2048 eval { 2049 deleteCourse( 2050 courseID => $archive_courseID, 2051 ce => $ce2, 2052 dbOptions => \%dbOptions, 2053 ); 2054 }; 2055 2056 if ($@) { 2057 my $error = $@; 2058 print CGI::div({class=>"ResultsWithError"}, 2059 CGI::p("An error occured while deleting the course $archive_courseID:"), 2060 CGI::tt(CGI::escapeHTML($error)), 2061 ); 2062 } else { 2063 # mark the contact person in the admin course as dropped. 2064 # find the contact person for the course by searching the admin classlist. 2065 my @contacts = grep /_$archive_courseID$/, $db->listUsers; 2066 if (@contacts) { 2067 die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1; 2068 #warn "contacts", join(" ", @contacts); 2069 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 2070 my $composite_id = $contacts[0]; 2071 2072 # mark the contact person as dropped. 2073 my $User = $db->getUser($composite_id); 2074 my $status_name = 'Drop'; 2075 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 2076 $User->status($status_value); 2077 $db->putUser($User); 2078 } 2079 2080 print CGI::div({class=>"ResultsWithoutError"}, 2081 CGI::p("Successfully deleted the course $archive_courseID."), 2082 ); 2083 } 2084 2085 2086 } 2087 2088 # print CGI::start_form(-method=>"POST", -action=>$r->uri); 2089 # print $self->hidden_authen_fields; 2090 # print $self->hidden_fields("subDisplay"); 2091 # 2092 # print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),); 2093 # 2094 # print CGI::end_form(); 2095 } 2096 } 2097 2098 ########################################################################## 2099 2100 sub unarchive_course_form { 2101 my ($self) = @_; 2102 my $r = $self->r; 2103 my $ce = $r->ce; 2104 #my $db = $r->db; 2105 #my $authz = $r->authz; 2106 #my $urlpath = $r->urlpath; 2107 2108 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2109 2110 # First find courses which have been archived. 2111 my @courseIDs = listArchivedCourses($ce); 2112 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 2113 2114 my %courseLabels; # records... heh. 2115 foreach my $courseID (@courseIDs) { 2116 $courseLabels{$courseID} = $courseID; 2117 } 2118 2119 print CGI::h2("Unarchive Course"); 2120 2121 print CGI::p( 2122 "Restores a course from a gzipped tar archive (.tar.gz). After 2123 unarchiving, the course database is restored from a subdirectory of the 2124 course's DATA directory. Currently the archive facility is only 2125 available for mysql databases. It depends on the mysqldump application." 2126 ); 2127 2128 print CGI::start_form(-method=>"POST", -action=>$r->uri); 2129 print $self->hidden_authen_fields; 2130 print $self->hidden_fields("subDisplay"); 2131 2132 print CGI::p("Select a course to unarchive."); 2133 2134 print CGI::table({class=>"FormLayout"}, 2135 CGI::Tr({}, 2136 CGI::th({class=>"LeftHeader"}, "Course Name:"), 2137 CGI::td( 2138 CGI::scrolling_list( 2139 -name => "unarchive_courseID", 2140 -values => \@courseIDs, 2141 -default => $unarchive_courseID, 2142 -size => 10, 2143 -multiple => 0, 2144 -labels => \%courseLabels, 2145 ), 2146 ), 2147 ), 2148 2149 CGI::Tr({}, 2150 CGI::th({class=>"LeftHeader"}, CGI::checkbox(-name => "create_newCourseID",-default=>'',-value=>1, -label=>'New Name:')), 2151 CGI::td(CGI::textfield(-name=>"new_courseID", -value=>'', -size=>25)), 2152 ), 2153 ); 2154 2155 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course")); 2156 2157 print CGI::end_form(); 2158 } 2159 2160 sub unarchive_course_validate { 2161 my ($self) = @_; 2162 my $r = $self->r; 2163 my $ce = $r->ce; 2164 #my $db = $r->db; 2165 #my $authz = $r->authz; 2166 my $urlpath = $r->urlpath; 2167 2168 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2169 my $create_newCourseID = $r->param("create_newCourseID") || ""; 2170 my $new_courseID = $r->param("new_courseID") || ""; 2171 my @errors; 2172 #by default we use the archive name for the course 2173 my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//; 2174 2175 if ( $create_newCourseID) { 2176 $courseID = $new_courseID; 2177 } 2178 debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); 2179 2180 if ($courseID eq "") { 2181 push @errors, "You must specify a course name."; 2182 } elsif ( -d $ce->{webworkDirs}->{courses}."/$courseID" ) { 2183 #Check that a directory for this course doesn't already exist 2184 push @errors, "A directory already exists with the name $courseID. 2185 You must first delete this existing course before you can unarchive."; 2186 } 2187 2188 2189 return @errors; 2190 } 2191 2192 sub unarchive_course_confirm { 2193 my ($self) = @_; 2194 my $r = $self->r; 2195 my $ce = $r->ce; 2196 #my $db = $r->db; 2197 #my $authz = $r->authz; 2198 #my $urlpath = $r->urlpath; 2199 2200 print CGI::h2("Unarchive Course"); 2201 2202 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2203 my $create_newCourseID = $r->param("create_newCourseID") || ""; 2204 my $new_courseID = $r->param("new_courseID") || ""; 2205 2206 my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//; 2207 2208 if ( $create_newCourseID) { 2209 $courseID = $new_courseID; 2210 } 2211 2212 debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); 2213 2214 print CGI::start_form(-method=>"POST", -action=>$r->uri); 2215 print CGI::p($unarchive_courseID," to course ", 2216 CGI::input({-name=>'new_courseID', -value=>$courseID}) 2217 ); 2218 2219 print $self->hidden_authen_fields; 2220 print $self->hidden_fields("subDisplay"); 2221 print $self->hidden_fields(qw/unarchive_courseID create_newCourseID/); 2222 2223 print CGI::p({style=>"text-align: center"}, 2224 CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"), 2225 " ", 2226 CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"), 2227 ); 2228 2229 print CGI::end_form(); 2230 } 2231 2232 sub do_unarchive_course { 2233 my ($self) = @_; 2234 my $r = $self->r; 2235 my $ce = $r->ce; 2236 #my $db = $r->db; 2237 #my $authz = $r->authz; 2238 my $urlpath = $r->urlpath; 2239 my $new_courseID = $r->param("new_courseID") || ""; 2240 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 2241 2242 my $old_courseID = $unarchive_courseID; $old_courseID =~ s/.tar.gz//; 2243 2244 #eval { 2245 unarchiveCourse( 2246 newCourseID => $new_courseID, 2247 oldCourseID => $old_courseID, 2248 archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID", 2249 ce => $ce, 2250 ); 2251 #}; 2252 2253 if ($@) { 2254 my $error = $@; 2255 print CGI::div({class=>"ResultsWithError"}, 2256 CGI::p("An error occured while archiving the course $unarchive_courseID:"), 2257 CGI::tt(CGI::escapeHTML($error)), 2258 ); 2259 } else { 2260 print CGI::div({class=>"ResultsWithoutError"}, 2261 CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"), 2262 ); 2263 writeLog($ce, "hosted_courses", join("\t", 2264 "\tunarchived", 2265 "", 2266 "", 2267 "$unarchive_courseID to $new_courseID", 2268 )); 2269 2270 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 2271 courseID => $new_courseID); 2272 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 2273 print CGI::div({style=>"text-align: center"}, 2274 CGI::a({href=>$newCourseURL}, "Log into $new_courseID"), 2275 ); 2276 } 2277 } 2278 2279 ################################################################################ 2280 ## location management routines; added by DG [Danny Ginn] 20070215 2281 ## revised by glarose 2282 2283 sub manage_location_form { 2284 my ($self) = @_; 2285 my $r = $self->r; 2286 my $ce = $r->ce; 2287 my $db = $r->db; 2288 #my $authz = $r->authz; 2289 my $urlpath = $r->urlpath; 2290 2291 # get a list of all existing locations 2292 my @locations = sort {lc($a->location_id) cmp lc($b->location_id)} 2293 $db->getAllLocations(); 2294 my %locAddr = map {$_->location_id => [ $db->listLocationAddresses($_->location_id) ]} @locations; 2295 2296 my @locationIDs = map { $_->location_id } @locations; 2297 2298 print CGI::h2("Manage Locations"); 2299 2300 print CGI::p({},CGI::strong("Currently defined locations are listed below.")); 2301 2302 print CGI::start_form(-method=>"POST", -action=>$r->uri); 2303 print $self->hidden_authen_fields; 2304 print $self->hidden_fields("subDisplay"); 2305 2306 # get a list of radio buttons to select an action 2307 my @actionRadios = 2308 CGI::radio_group(-name => "manage_location_action", 2309 -values => ["edit_location_form", 2310 "add_location_handler", 2311 "delete_location_handler"], 2312 -labels => { edit_location_form => "", 2313 add_location_handler => "", 2314 delete_location_handler => "", }, 2315 -default => $r->param("manage_location_action") ? $r->param("manage_location_action") : 'none'); 2316 2317 print CGI::start_table({}); 2318 print CGI::Tr({}, CGI::th({-colspan=>4,-align=>"left"}, 2319 "Select an action to perform:")); 2320 2321 # edit action 2322 print CGI::Tr({}, 2323 CGI::td({},[ $actionRadios[0], "Edit Location:" ]), 2324 CGI::td({-colspan=>2, -align=>"left"}, 2325 CGI::div({-style=>"width:25%;"}, 2326 CGI::popup_menu(-name=>"edit_location", 2327 -values=>[@locationIDs]))) ); 2328 # create action 2329 print CGI::Tr({}, 2330 CGI::td({-align=>"left"},[ $actionRadios[1], 2331 "Create Location:" ]), 2332 CGI::td({-colspan=>2}, 2333 "Location name: " . 2334 CGI::textfield(-name=>"new_location_name", 2335 -size=>"10", 2336 -default=>$r->param("new_location_name")?$r->param("new_location_name"):''))); 2337 print CGI::Tr({valign=>'top'}, 2338 CGI::td({}, [" ", "Location description:"]), 2339 CGI::td({-colspan=>2}, 2340 CGI::textfield(-name=>"new_location_description", 2341 -size=>"50", 2342 -default=>$r->param("new_location_description")?$r->param("new_location_description"):'')) ); 2343 print CGI::Tr({}, CGI::td({}," "), 2344 CGI::td({-colspan=>3}, "Addresses for new location " . 2345 "(enter one per line, as single IP addresses " . 2346 "(e.g., 192.168.1.101), address masks (e.g., " . 2347 "192.168.1.0/24), or IP ranges (e.g., " . 2348 "192.168.1.101-192.168.1.150)):")); 2349 print CGI::Tr({}, CGI::td({}, " "), 2350 CGI::td({-colspan=>3}, 2351 CGI::textarea({-name=>"new_location_addresses", 2352 -rows=>5, -columns=>28, 2353 -default=>$r->param("new_location_addresses")?$r->param("new_location_addresses"):''}))); 2354 2355 # delete action 2356 print CGI::Tr({}, 2357 CGI::td({-colspan=>4}, 2358 CGI::div({-class=>"ResultsWithError"}, 2359 CGI::em({}, "Deletion deletes all location " . 2360 "data and related addresses, and is" . 2361 2362 " not undoable!")))); 2363 print CGI::Tr({}, 2364 CGI::td({}, 2365 [ $actionRadios[2], 2366 CGI::div({-class=>"ResultsWithError"}, 2367 "Delete location:") ]), 2368 CGI::td({-colspan=>2}, 2369 CGI::popup_menu(-name=>"delete_location", 2370 -values=>["", 2371 "selected_locations", 2372 @locationIDs], 2373 -labels=>{selected_locations => "locations selected below", 2374 "" => "no location"}) . 2375 CGI::span({-style=>"color:#C33;"}, " Confirm: ") . 2376 CGI::checkbox({-name=>"delete_confirm", 2377 -value=>"true", 2378 -label=>""}) ) ); 2379 print CGI::end_table(); 2380 2381 print CGI::p({}, CGI::submit(-name=>"manage_locations", -value=>"Take Action!")); 2382 2383 # existing location table 2384 # FIXME: the styles for this table should be off in a stylesheet 2385 # somewhere 2386 print CGI::start_div({align=>"center"}), 2387 CGI::start_table({border=>1, cellpadding=>2}); 2388 print CGI::Tr({style=>"background-color:#e0e0e0;font-size:92%", align=>"left"}, 2389 CGI::th({}, ["Select", "Location", "Description", 2390 "Addresses"])); 2391 foreach my $loc ( @locations ) { 2392 my $editAddr = $self->systemLink($urlpath, params=>{subDisplay=>"manage_locations", manage_location_action=>"edit_location_form", edit_location=>$loc->location_id}); 2393 print CGI::Tr({valign=>'top',style=>"background-color:#eeeeee;"}, 2394 CGI::td({style=>'font-size:85%;'}, 2395 [ CGI::checkbox(-name=>"delete_selected", 2396 -value=>$loc->location_id, 2397 -label=>''), 2398 CGI::a({href=>$editAddr}, $loc->location_id), 2399 $loc->description, 2400 join(', ', @{$locAddr{$loc->location_id}}) ])); 2401 } 2402 print CGI::end_table(), CGI::end_div(); 2403 print CGI::end_form(); 2404 2405 2406 } 2407 2408 sub add_location_handler { 2409 my $self = shift(); 2410 my $r = $self->r; 2411 my $db = $r->db; 2412 2413 # the location data we're to add 2414 my $locationID = $r->param("new_location_name"); 2415 my $locationDescr = $r->param("new_location_description"); 2416 my $locationAddr = $r->param("new_location_addresses"); 2417 # break the addresses up 2418 $locationAddr =~ s/\s*-\s*/-/g; 2419 $locationAddr =~ s/\s*\/\s*/\//g; 2420 my @addresses = split(/\s+/, $locationAddr); 2421 2422 # sanity checks 2423 my $badAddr = ''; 2424 foreach my $addr ( @addresses ) { 2425 unless ( new Net::IP($addr) ) { 2426 $badAddr .= "$addr, "; 2427 $locationAddr =~ s/$addr\n//s; 2428 } 2429 } 2430 $badAddr =~ s/, $//; 2431 2432 # a check to be sure that the location addresses don't already 2433 # exist 2434 my $badLocAddr; 2435 if ( ! $badAddr && $locationID ) { 2436 if ( $db->countLocationAddresses( $locationID ) ) { 2437 my @allLocAddr = $db->listLocationAddresses($locationID); 2438 foreach my $addr ( @addresses ) { 2439 $badLocAddr .= "$addr, " 2440 if ( grep {/^$addr$/} @allLocAddr ); 2441 } 2442 $badLocAddr =~ s/, $//; 2443 } 2444 } 2445 2446 if ( ! @addresses || ! $locationID || ! $locationDescr ) { 2447 print CGI::div({-class=>"ResultsWithError"}, 2448 "Missing required input data. Please check " . 2449 "that you have filled in all of the create " . 2450 "location fields and resubmit."); 2451 } elsif ( $badAddr ) { 2452 $r->param("new_location_addresses", $locationAddr); 2453 print CGI::div({-class=>"ResultsWithError"}, 2454 "Address(es) $badAddr is(are) not in a " . 2455 "recognized form. Please check your " . 2456 "data entry and resubmit."); 2457 } elsif ( $db->existsLocation( $locationID ) ) { 2458 print CGI::div({-class=>"ResultsWithError"}, 2459 "A location with the name $locationID " . 2460 "already exists in the database. Did " . 2461 "you mean to edit that location instead?"); 2462 } elsif ( $badLocAddr ) { 2463 print CGI::div({-class=>"ResultsWithError"}, 2464 "Address(es) $badLocAddr already exist " . 2465 "in the database. THIS SHOULD NOT HAPPEN! " . 2466 "Please double check the integrity of " . 2467 "the WeBWorK database before continuing."); 2468 } else { 2469 # add the location 2470 my $locationObj = $db->newLocation; 2471 $locationObj->location_id( $locationID ); 2472 $locationObj->description( $locationDescr ); 2473 $db->addLocation( $locationObj ); 2474 2475 # and add the addresses 2476 foreach my $addr ( @addresses ) { 2477 my $locationAddress = $db->newLocationAddress; 2478 $locationAddress->location_id($locationID); 2479 $locationAddress->ip_mask($addr); 2480 2481 $db->addLocationAddress( $locationAddress ); 2482 } 2483 2484 # we've added the location, so clear those param 2485 # entries 2486 $r->param('manage_location_action','none'); 2487 $r->param('new_location_name',''); 2488 $r->param('new_location_description',''); 2489 $r->param('new_location_addresses',''); 2490 2491 print CGI::div({-class=>"ResultsWithoutError"}, 2492 "Location $locationID has been created, " . 2493 "with addresses " . join(', ', @addresses) . 2494 "."); 2495 } 2496 2497 $self->manage_location_form; 2498 } 2499 2500 sub delete_location_handler { 2501 my $self = shift; 2502 my $r = $self->r; 2503 my $db = $r->db; 2504 2505 # what location are we deleting? 2506 my $locationID = $r->param("delete_location"); 2507 # check for selected deletions if appropriate 2508 my @delLocations = ( $locationID ); 2509 if ( $locationID eq 'selected_locations' ) { 2510 @delLocations = $r->param("delete_selected"); 2511 $locationID = @delLocations; 2512 } 2513 # are we sure? 2514 my $confirm = $r->param("delete_confirm"); 2515 2516 my $badID; 2517 if ( ! $locationID ) { 2518 print CGI::div({-class=>"ResultsWithError"}, 2519 "Please provide a location name " . 2520 "to delete."); 2521 2522 } elsif ( $badID = $self->existsLocations_helper( @delLocations ) ) { 2523 print CGI::div({-class=>"ResultsWithError"}, 2524 "No location with name $badID " . 2525 "exists in the database."); 2526 2527 } elsif ( ! $confirm || $confirm ne 'true' ) { 2528 print CGI::div({-class=>"ResultsWithError"}, 2529 "Location deletion requires confirmation."); 2530 } else { 2531 foreach ( @delLocations ) { 2532 $db->deleteLocation( $_ ); 2533 } 2534 print CGI::div({-class=>"ResultsWithoutError"}, 2535 "Location" . (@delLocations > 1 ? 's ' : ' ') . 2536 join(', ', @delLocations) . 2537 (@delLocations > 1 ? ' have ' : ' has ' ) . 2538 'been deleted.'); 2539 $r->param('manage_location_action','none'); 2540 $r->param('delete_location',''); 2541 } 2542 $self->manage_location_form; 2543 } 2544 sub existsLocations_helper { 2545 my ($self, @locations) = @_; 2546 my $db = $self->r->db; 2547 foreach ( @locations ) { 2548 return $_ if ( ! $db->existsLocation($_) ); 2549 } 2550 return 0; 2551 } 2552 2553 sub edit_location_form { 2554 my $self = shift; 2555 my $r = $self->r; 2556 my $db = $r->db; 2557 2558 my $locationID = $r->param("edit_location"); 2559 if ( $db->existsLocation( $locationID ) ) { 2560 my $location = $db->getLocation($locationID); 2561 # this doesn't give that nice a sort for IP addresses, 2562 # b/c there's the problem with 192.168.1.168 sorting 2563 # ahead of 192.168.1.2. we could do better if we 2564 # either invoked Net::IP in the sort routine, or if 2565 # we insisted on dealing only with IPv4. rather than 2566 # deal with either of those, we'll leave this for now 2567 my @locAddresses = sort { $a cmp $b } 2568 $db->listLocationAddresses($locationID); 2569 2570 print CGI::h2("Editing location ", $locationID); 2571 2572 print CGI::p({},"Edit the current value of the location ", 2573 "description, if desired, then add and select ", 2574 "addresses to delete, and then click the ", 2575 "\"Take Action\" button to make all of your ", 2576 "changes. Or, click \"Manage Locations\" ", 2577 "above to make no changes and return to the ", 2578 "Manage Locations page."); 2579 2580 print CGI::start_form(-method=>"POST", 2581 -action=>$r->uri); 2582 print $self->hidden_authen_fields; 2583 print $self->hidden_fields("subDisplay"); 2584 print CGI::hidden(-name=>'edit_location', 2585 -default=>$locationID); 2586 print CGI::hidden(-name=>'manage_location_action', 2587 -default=>'edit_location_handler'); 2588 2589 print CGI::start_table(); 2590 print CGI::Tr({-valign=>'top'}, 2591 CGI::td({-colspan=>3}, 2592 "Location description: ", CGI::br(), 2593 CGI::textfield(-name=>"location_description", 2594 -size=>"50", 2595 -default=>$location->description))); 2596 print CGI::Tr({-valign=>'top'}, 2597 CGI::td({-width=>"50%"}, 2598 "Addresses to add to the location " . 2599 "(enter one per line, as single IP addresses " . 2600 "(e.g., 192.168.1.101), address masks " . 2601 "(e.g., 192.168.1.0/24), or IP ranges " . 2602 "(e.g., 192.168.1.101-192.168.1.150)):" . 2603 CGI::br() . 2604 CGI::textarea({-name=>"new_location_addresses", 2605 -rows=>5, -columns=>28})), 2606 CGI::td({}, " "), 2607 CGI::td({-width=>"50%"}, 2608 "Existing addresses for the location are " . 2609 "given in the scrolling list below. Select " . 2610 "addresses from the list to delete them:" . 2611 CGI::br() . 2612 CGI::scrolling_list(-name=>'delete_location_addresses', 2613 -values=>[@locAddresses], 2614 -size=>8, 2615 -multiple=>'multiple') . 2616 CGI::br() . "or: " . 2617 CGI::checkbox(-name=>'delete_all_addresses', 2618 -value=>'true', 2619 -label=>'Delete all existing addresses') 2620 )); 2621 2622 print CGI::end_table(); 2623 2624 print CGI::p({},CGI::submit(-value=>'Take Action!')); 2625 2626 } else { 2627 print CGI::div({-class=>"ResultsWithError"}, 2628 "Location $locationID does not exist " . 2629 "in the WeBWorK database. Please check " . 2630 "your input (perhaps you need to reload " . 2631 "the location management page?)."); 2632 2633 $self->manage_location_form; 2634 } 2635 } 2636 2637 sub edit_location_handler { 2638 my $self = shift; 2639 my $r = $self->r; 2640 my $db = $r->db; 2641 2642 my $locationID = $r->param("edit_location"); 2643 my $locationDesc = $r->param("location_description"); 2644 my $addAddresses = $r->param("new_location_addresses"); 2645 my @delAddresses = $r->param("delete_location_addresses"); 2646 my $deleteAll = $r->param("delete_all_addresses"); 2647 2648 # gut check 2649 if ( ! $locationID ) { 2650 print CGI::div({-class=>"ResultsWithError"}, 2651 "No location specified to edit?! " . 2652 "Please check your input data."); 2653 $self->manage_location_form; 2654 2655 } elsif ( ! $db->existsLocation( $locationID ) ) { 2656 print CGI::div({-class=>"ResultsWithError"}, 2657 "Location $locationID does not exist " . 2658 "in the WeBWorK database. Please check " . 2659 "your input (perhaps you need to reload " . 2660 "the location management page?)."); 2661 $self->manage_location_form; 2662 } else { 2663 my $location = $db->getLocation($locationID); 2664 2665 # get the current location addresses. if we're deleting 2666 # all of the existing addresses, we don't use this list 2667 # to determine which addresses to add, however. 2668 my @currentAddr = $db->listLocationAddresses($locationID); 2669 my @compareAddr = ( ! $deleteAll || $deleteAll ne 'true' ) 2670 ? @currentAddr : (); 2671 2672 my $doneMsg = ''; 2673 2674 if ($locationDesc && $location->description ne $locationDesc) { 2675 $location->description($locationDesc); 2676 $db->putLocation($location); 2677 $doneMsg .= CGI::p({},"Updated location description."); 2678 } 2679 # get the actual addresses to add out of the text field 2680 $addAddresses =~ s/\s*-\s*/-/g; 2681 $addAddresses =~ s/\s*\/\s*/\//g; 2682 my @addAddresses = split(/\s+/, $addAddresses); 2683 2684 # make sure that we're adding and deleting only those 2685 # addresses that are not yet/currently in the location 2686 # addresses 2687 my @toAdd = (); my @noAdd = (); 2688 my @toDel = (); my @noDel = (); 2689 foreach my $addr ( @addAddresses ) { 2690 if (grep {/^$addr$/} @compareAddr) {push(@noAdd,$addr);} 2691 else { push(@toAdd, $addr); } 2692 } 2693 if ( $deleteAll && $deleteAll eq 'true' ) { 2694 @toDel = @currentAddr; 2695 } else { 2696 foreach my $addr ( @delAddresses ) { 2697 if (grep {/^$addr$/} @currentAddr) { 2698 push(@toDel,$addr); 2699 } else { push(@noDel, $addr); } 2700 } 2701 } 2702 2703 # and make sure that all of the addresses we're adding are 2704 # a sensible form 2705 my $badAddr = ''; 2706 foreach my $addr ( @toAdd ) { 2707 unless ( new Net::IP($addr) ) { 2708 $badAddr .= "$addr, "; 2709 } 2710 } 2711 $badAddr =~ s/, $//; 2712 2713 # delete addresses first, because we allow deletion of 2714 # all existing addresses, then addition of addresses. 2715 # note that we don't allow deletion and then addition 2716 # of the same address normally, however; in that case 2717 # we'll end up just deleting the address. 2718 foreach ( @toDel ) { 2719 $db->deleteLocationAddress($locationID, $_); 2720 } 2721 foreach ( @toAdd ) { 2722 my $locAddr = $db->newLocationAddress; 2723 $locAddr->location_id($locationID); 2724 $locAddr->ip_mask($_); 2725 2726 $db->addLocationAddress($locAddr); 2727 } 2728 2729 my $addrMsg = ''; 2730 $addrMsg .= "Deleted addresses " . join(', ', @toDel) . 2731 " from location." . CGI::br() if ( @toDel ); 2732 $addrMsg .= "Added addresses " . join(', ', @toAdd) . 2733 " to location $locationID. " if ( @toAdd ); 2734 2735 my $badMsg = ''; 2736 $badMsg .= 'Address(es) ' . join(', ', @noAdd) . 2737 " in the add list is(are) already in the " . 2738 "location $locationID, and so were " . 2739 "skipped." . CGI::br() if ( @noAdd ); 2740 $badMsg .= "Address(es) $badAddr is(are) not in a " . 2741 "recognized form. Please check your data " . 2742 "entry and try again." . CGI::br() if ( $badAddr ); 2743 $badMsg .= 'Address(es) ' . join(', ', @noDel) . 2744 " in the delete list is(are) not in the " . 2745 "location $locationID, and so were " . 2746 "skipped." if ( @noDel ); 2747 2748 print CGI::div({-class=>"ResultsWithError"}, $badMsg) 2749 if ( $badMsg ); 2750 if ( $doneMsg || $addrMsg ) { 2751 print CGI::div({-class=>"ResultsWithoutError"}, 2752 CGI::p({}, $doneMsg, $addrMsg)); 2753 } else { 2754 print CGI::div({-class=>"ResultsWithError"}, 2755 "No valid changes submitted for ", 2756 "location $locationID."); 2757 } 2758 2759 $self->edit_location_form; 2760 } 2761 } 2762 2763 ################################################################################ 2764 # registration forms added by Mike Gage 5-5-2008 2765 ################################################################################ 2766 2767 our $registered_file_name = "registered_$main::VERSION"; 2768 2769 sub display_registration_form { 2770 my $self = shift; 2771 my $ce = $self->r->ce; 2772 my $registeredQ = (-e ($ce->{courseDirs}->{root})."/$registered_file_name")?1:0; 2773 #my $registration_subDisplay = ( $self->{method_to_call} eq "registration_form") ? 1: 0; 2774 return 0 if $registeredQ or $self->r->param("register_site"); #otherwise return registration form 2775 return q! 2776 <center> 2777 <table class="messagebox" style="background-color:#FFFFCC;width:60%"> 2778 <tr><td> 2779 !, 2780 CGI::p("If you are using your WeBWorK server for courses please help us out by registering your server."), 2781 CGI::p("We are often asked how many institutions are using WeBWorK and how many students are using 2782 WeBWorK Since WeBWorK is open source and can be freely downloaded from ". 2783 CGI::a({href=>'http://webwork.maa.org'},'http://webwork.maa.org' ). " and ". 2784 CGI::a({href=> 'http://www.openwebwork.org'},'http://www.openwebwork.org'). ", it is frequently difficult for us to give a reasonable answer to this 2785 question."), 2786 CGI::p("You can help by registering your current version of WeBWorK -- click the button, answer a few 2787 questions (the ones you can answer easily) and send the email. It takes less than two minutes. Thank you!. -- The WeBWorK Team"), 2788 q! 2789 </td> 2790 </tr> 2791 <tr><td align="center"> 2792 !, 2793 CGI::a({href=>$self->systemLink($self->r->urlpath, params=>{subDisplay=>"registration"})}, "Register"), 2794 q! 2795 </td></tr> 2796 </table> 2797 </center> 2798 !; 2799 2800 2801 2802 } 2803 2804 sub registration_form { 2805 my $self = shift; 2806 my $ce = $self->r->ce; 2807 2808 print "<center>"; 2809 print "\n",CGI::p({style=>"text-align: left; width:60%"}, 2810 "\nPlease ", 2811 CGI::a({href=>'mailto:gage@math.rochester.edu?' 2812 .'subject=WeBWorK%20Server%20Registration' 2813 .'&body=' 2814 .uri_escape("Thanks for registering your WeBWorK server. We'd appreciate if you would answer 2815 as many of these questions as you can conveniently. We need this data so we can better 2816 answer questions such as 'How many institutions have webwork servers?' and 'How many students 2817 use WeBWorK?'. Your email and contact information will be kept private. We will 2818 list your institution as one that uses WeBWorK unless you tell us to keep that private as well. 2819 \n\nThank you. \n\n--Mike Gage \n\n 2820 ") 2821 .uri_escape("Server URL: ".$ce->{apache_root_url}." \n\n") 2822 .uri_escape("WeBWorK version: $main::VERSION \n\n") 2823 .uri_escape("Institution name (e.g. University of Rochester): \n\n") 2824 .uri_escape("Contact person name: \n\n") 2825 .uri_escape("Contact email: \n\n") 2826 .uri_escape("Approximate number of courses run each term: \n\n") 2827 .uri_escape("Approximate number of students using this server each term: \n\n") 2828 .uri_escape("Other institutions who use WeBWorK courses hosted on this server: \n\n") 2829 .uri_escape("Other comments: \n\n") 2830 }, 2831 'click here'), 2832 q! to open your email application. There are a few questions, some of which have already 2833 been filled in for your installation. Fill in the other questions which you can answer easily and send 2834 the email to gage@math.rochester.edu 2835 ! 2836 ); 2837 2838 2839 2840 print "\n",CGI::p({style=>"text-align: left; width:60%"},q!Once you have emailed your registration information you can hide the "registration" banner 2841 for successive visits by clicking 2842 the button below. It writes an empty file (!.CGI::code('registered_versionNumber').q!) to the directory !.CGI::code('..../courses/admin') 2843 ); 2844 2845 print "</center>"; 2846 print CGI::start_form(-method=>"POST", -action=>$self->r->uri); 2847 print $self->hidden_authen_fields; 2848 print $self->hidden_fields("subDisplay"); 2849 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"register_site", -label=>"Site has been registered")); 2850 print CGI::end_form(); 2851 } 2852 2853 2854 2855 sub do_registration { 2856 my $self = shift; 2857 my $ce = $self->r->ce; 2858 my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name"; 2859 # warn qq!`echo "info" >$registered_file_path`!; 2860 `echo "info" >$registered_file_path`; 2861 2862 print "\n<center>",CGI::p({style=>"text-align: left; width:60%"},q{Registration action completed. Thank you very much for registering WeBWorK!"}); 2863 2864 print CGI::start_form(-method=>"POST", -action=>$self->r->uri); 2865 print $self->hidden_authen_fields; 2866 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"registration_completed", -label=>"Continue")); 2867 print CGI::end_form(); 2868 print "</center>"; 2869 2870 } 2871 ################################################################################ 2872 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |