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