Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-3-dev'.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.56 2006/08/08 16:03:25 sh002i Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::CourseAdmin; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI 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 WeBWorK::Debug; 35 use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive); 36 use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse 37 listArchivedCourses unarchiveCourse); 38 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 39 40 use constant IMPORT_EXPORT_WARNING => "The ability to import and export 41 databases is still under development. It seems to work but it is <b>VERY</b> 42 slow on large courses. You may prefer to use webwork2/bin/wwdb or the mysql 43 dump facility for archiving large courses. Please send bug reports if you find 44 errors."; 45 46 sub pre_header_initialize { 47 my ($self) = @_; 48 my $r = $self->r; 49 my $ce = $r->ce; 50 my $db = $r->db; 51 my $authz = $r->authz; 52 my $urlpath = $r->urlpath; 53 my $user = $r->param('user'); 54 55 # check permissions 56 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 57 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 58 return; 59 } 60 61 # get result and send to message 62 my $status_message = $r->param("status_message"); 63 $self->addmessage(CGI::p("$status_message")) if $status_message; 64 65 ## if the user is asking for the downloaded database... 66 #if (defined $r->param("download_exported_database")) { 67 # my $courseID = $r->param("export_courseID"); 68 # my $random_chars = $r->param("download_exported_database"); 69 # 70 # die "courseID not specified" unless defined $courseID; 71 # die "invalid file specification" unless $random_chars =~ m/^\w+$/; 72 # 73 # my $tempdir = $ce->{webworkDirs}->{tmp}; 74 # my $export_file = "$tempdir/db_export_$random_chars"; 75 # 76 # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0); 77 # 78 # return ""; 79 #} 80 # 81 ## otherwise... 82 83 my @errors; 84 my $method_to_call; 85 86 my $subDisplay = $r->param("subDisplay"); 87 if (defined $subDisplay) { 88 89 if ($subDisplay eq "add_course") { 90 if (defined $r->param("add_course")) { 91 @errors = $self->add_course_validate; 92 if (@errors) { 93 $method_to_call = "add_course_form"; 94 } else { 95 $method_to_call = "do_add_course"; 96 } 97 } else { 98 $method_to_call = "add_course_form"; 99 } 100 } 101 102 elsif ($subDisplay eq "rename_course") { 103 if (defined $r->param("rename_course")) { 104 @errors = $self->rename_course_validate; 105 if (@errors) { 106 $method_to_call = "rename_course_form"; 107 } else { 108 $method_to_call = "do_rename_course"; 109 } 110 } else { 111 $method_to_call = "rename_course_form"; 112 } 113 } 114 115 elsif ($subDisplay eq "delete_course") { 116 if (defined $r->param("delete_course")) { 117 # validate or confirm 118 @errors = $self->delete_course_validate; 119 if (@errors) { 120 $method_to_call = "delete_course_form"; 121 } else { 122 $method_to_call = "delete_course_confirm"; 123 } 124 } elsif (defined $r->param("confirm_delete_course")) { 125 # validate and delete 126 @errors = $self->delete_course_validate; 127 if (@errors) { 128 $method_to_call = "delete_course_form"; 129 } else { 130 $method_to_call = "do_delete_course"; 131 } 132 } else { 133 # form only 134 $method_to_call = "delete_course_form"; 135 } 136 } 137 138 elsif ($subDisplay eq "export_database") { 139 if (defined $r->param("export_database")) { 140 @errors = $self->export_database_validate; 141 if (@errors) { 142 $method_to_call = "export_database_form"; 143 } else { 144 # we have to do something special here, since we're sending 145 # the database as we export it. $method_to_call still gets 146 # set here, but it gets caught by header() and content() 147 # below instead of by body(). 148 $method_to_call = "do_export_database"; 149 } 150 } else { 151 $method_to_call = "export_database_form"; 152 } 153 } 154 155 elsif ($subDisplay eq "import_database") { 156 if (defined $r->param("import_database")) { 157 @errors = $self->import_database_validate; 158 if (@errors) { 159 $method_to_call = "import_database_form"; 160 } else { 161 $method_to_call = "do_import_database"; 162 } 163 } else { 164 $method_to_call = "import_database_form"; 165 } 166 } 167 168 elsif ($subDisplay eq "archive_course") { 169 if (defined $r->param("archive_course")) { 170 # validate or confirm 171 @errors = $self->archive_course_validate; 172 if (@errors) { 173 $method_to_call = "archive_course_form"; 174 } else { 175 $method_to_call = "archive_course_confirm"; 176 } 177 } elsif (defined $r->param("confirm_archive_course")) { 178 # validate and archive 179 @errors = $self->archive_course_validate; 180 if (@errors) { 181 $method_to_call = "archive_course_form"; 182 } else { 183 $method_to_call = "do_archive_course"; 184 } 185 } else { 186 # form only 187 $method_to_call = "archive_course_form"; 188 } 189 } 190 elsif ($subDisplay eq "unarchive_course") { 191 if (defined $r->param("unarchive_course")) { 192 # validate or confirm 193 @errors = $self->unarchive_course_validate; 194 if (@errors) { 195 $method_to_call = "unarchive_course_form"; 196 } else { 197 $method_to_call = "unarchive_course_confirm"; 198 } 199 } elsif (defined $r->param("confirm_unarchive_course")) { 200 # validate and archive 201 @errors = $self->unarchive_course_validate; 202 if (@errors) { 203 $method_to_call = "unarchive_course_form"; 204 } else { 205 $method_to_call = "do_unarchive_course"; 206 } 207 } else { 208 # form only 209 $method_to_call = "unarchive_course_form"; 210 } 211 } 212 else { 213 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 214 } 215 216 } 217 218 $self->{errors} = \@errors; 219 $self->{method_to_call} = $method_to_call; 220 } 221 222 sub header { 223 my ($self) = @_; 224 my $method_to_call = $self->{method_to_call}; 225 # if (defined $method_to_call and $method_to_call eq "do_export_database") { 226 # my $r = $self->r; 227 # my $courseID = $r->param("export_courseID"); 228 # $r->content_type("application/octet-stream"); 229 # $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 230 # $r->send_http_header; 231 # } else { 232 $self->SUPER::header; 233 # } 234 } 235 236 # sends: 237 # 238 # HTTP/1.1 200 OK 239 # Date: Fri, 09 Jul 2004 19:05:55 GMT 240 # Server: Apache/1.3.27 (Unix) mod_perl/1.27 241 # Content-Disposition: attachment; filename="mth143_database.xml" 242 # Connection: close 243 # Content-Type: application/octet-stream 244 245 sub content { 246 my ($self) = @_; 247 my $method_to_call = $self->{method_to_call}; 248 if (defined $method_to_call and $method_to_call eq "do_export_database") { 249 #$self->do_export_database; 250 $self->SUPER::content; 251 } else { 252 $self->SUPER::content; 253 } 254 } 255 256 sub body { 257 my ($self) = @_; 258 my $r = $self->r; 259 my $ce = $r->ce; 260 my $db = $r->db; 261 my $authz = $r->authz; 262 my $urlpath = $r->urlpath; 263 264 my $user = $r->param('user'); 265 266 # check permissions 267 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 268 return ""; 269 } 270 my $method_to_call = $self->{method_to_call}; 271 my $methodMessage =""; 272 273 (defined($method_to_call) and $method_to_call eq "do_export_database") && do { 274 my @export_courseID = $r->param("export_courseID"); 275 my $course_ids = join(", ", @export_courseID); 276 $methodMessage = CGI::p("Exporting database for course(s) $course_ids"). 277 CGI::p(".... please wait.... 278 If your browser times out you will 279 still be able to download the exported database using the 280 file manager.").CGI::hr(); 281 }; 282 283 284 print CGI::p({style=>"text-align: center"}, 285 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1, 286 add_dbLayout=>'sql_single', 287 add_templates_course => $ce->{siteDefaults}->{default_templates_course} ||""} 288 )}, 289 "Add Course" 290 ), 291 " | ", 292 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"), 293 " | ", 294 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 295 " | ", 296 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 297 " | ", 298 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 299 " | ", 300 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"), 301 "|", 302 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"), 303 CGI::hr(), 304 $methodMessage, 305 306 ); 307 308 my @errors = @{$self->{errors}}; 309 310 311 if (@errors) { 312 print CGI::div({class=>"ResultsWithError"}, 313 CGI::p("Please correct the following errors and try again:"), 314 CGI::ul(CGI::li(\@errors)), 315 ); 316 } 317 318 if (defined $method_to_call and $method_to_call ne "") { 319 $self->$method_to_call; 320 } else { 321 322 print CGI::h2("Courses"); 323 324 print CGI::start_ol(); 325 326 my @courseIDs = listCourses($ce); 327 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 328 next if $courseID eq "admin"; # done already above 329 my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID); 330 my $tempCE = WeBWorK::CourseEnvironment->new( 331 $ce->{webworkDirs}->{root}, 332 $ce->{webworkURLs}->{root}, 333 $ce->{pg}->{directories}->{root}, 334 $courseID, 335 ); 336 print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID), 337 CGI::code( 338 $tempCE->{dbLayoutName}, 339 ), 340 (-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"), 341 342 ); 343 344 } 345 346 print CGI::end_ol(); 347 348 print CGI::h2("Archived Courses"); 349 print CGI::start_ol(); 350 351 @courseIDs = listArchivedCourses($ce); 352 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { 353 print CGI::li($courseID), 354 } 355 356 print CGI::end_ol(); 357 } 358 return ""; 359 } 360 361 ################################################################################ 362 363 sub add_course_form { 364 my ($self) = @_; 365 my $r = $self->r; 366 my $ce = $r->ce; 367 #my $db = $r->db; 368 #my $authz = $r->authz; 369 #my $urlpath = $r->urlpath; 370 371 my $add_courseID = $r->param("add_courseID") || ""; 372 my $add_courseTitle = $r->param("add_courseTitle") || ""; 373 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 374 375 my $add_admin_users = $r->param("add_admin_users") || ""; 376 377 my $add_initial_userID = $r->param("add_initial_userID") || ""; 378 my $add_initial_password = $r->param("add_initial_password") || ""; 379 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 380 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 381 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 382 my $add_initial_email = $r->param("add_initial_email") || ""; 383 384 my $add_templates_course = $r->param("add_templates_course") || ""; 385 386 my $add_dbLayout = $r->param("add_dbLayout") || ""; 387 388 my @dbLayouts = do { 389 my @ordered_layouts; 390 foreach my $layout (@{$ce->{dbLayout_order}}) { 391 if (exists $ce->{dbLayouts}->{$layout}) { 392 push @ordered_layouts, $layout; 393 } 394 } 395 396 my %ordered_layouts; @ordered_layouts{@ordered_layouts} = (); 397 my @other_layouts; 398 foreach my $layout (keys %{ $ce->{dbLayouts} }) { 399 unless (exists $ordered_layouts{$layout}) { 400 push @other_layouts, $layout; 401 } 402 } 403 404 (@ordered_layouts, @other_layouts); 405 }; 406 407 my $ce2 = WeBWorK::CourseEnvironment->new( 408 $ce->{webworkDirs}->{root}, 409 $ce->{webworkURLs}->{root}, 410 $ce->{pg}->{directories}->{root}, 411 "COURSENAME", 412 ); 413 414 my @existingCourses = listCourses($ce); 415 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive 416 417 print CGI::h2("Add Course"); 418 419 print CGI::start_form(-method=>"POST", -action=>$r->uri); 420 print $self->hidden_authen_fields; 421 print $self->hidden_fields("subDisplay"); 422 423 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 424 425 print CGI::table({class=>"FormLayout"}, 426 CGI::Tr({}, 427 CGI::th({class=>"LeftHeader"}, "Course ID:"), 428 CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)), 429 ), 430 CGI::Tr({}, 431 CGI::th({class=>"LeftHeader"}, "Course Title:"), 432 CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)), 433 ), 434 CGI::Tr({}, 435 CGI::th({class=>"LeftHeader"}, "Institution:"), 436 CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)), 437 ), 438 ); 439 440 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 441 my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked. 442 print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course")); 443 444 print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only 445 numbers, letters, hyphens, periods (dots), commas,and underscores.\n"); 446 447 print CGI::table({class=>"FormLayout"}, CGI::Tr({}, 448 CGI::td({}, 449 CGI::table({class=>"FormLayout"}, 450 CGI::Tr({}, 451 CGI::th({class=>"LeftHeader"}, "User ID:"), 452 CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)), 453 ), 454 CGI::Tr({}, 455 CGI::th({class=>"LeftHeader"}, "Password:"), 456 CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)), 457 ), 458 CGI::Tr({}, 459 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 460 CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)), 461 ), 462 ), 463 ), 464 CGI::td({}, 465 CGI::table({class=>"FormLayout"}, 466 CGI::Tr({}, 467 CGI::th({class=>"LeftHeader"}, "First Name:"), 468 CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)), 469 ), 470 CGI::Tr({}, 471 CGI::th({class=>"LeftHeader"}, "Last Name:"), 472 CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)), 473 ), 474 CGI::Tr({}, 475 CGI::th({class=>"LeftHeader"}, "Email Address:"), 476 CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)), 477 ), 478 ), 479 480 ), 481 )); 482 483 print CGI::p("To copy problem templates from an existing course, select the course below."); 484 485 print CGI::table({class=>"FormLayout"}, 486 CGI::Tr({}, 487 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 488 CGI::td( 489 CGI::popup_menu( 490 -name => "add_templates_course", 491 -values => [ "", @existingCourses ], 492 -default => $add_templates_course, 493 #-size => 10, 494 #-multiple => 0, 495 #-labels => \%courseLabels, 496 ), 497 498 ), 499 ), 500 ); 501 502 503 504 print CGI::p("Select a database layout below."); 505 print CGI::start_table({class=>"FormLayout"}); 506 507 my %dbLayout_buttons; 508 my $selected_dbLayout = defined $add_dbLayout ? $add_dbLayout : $ce->{dbLayout_order}[0]; 509 @dbLayout_buttons{@dbLayouts} = CGI::radio_group(-name=>"add_dbLayout",-values=>\@dbLayouts,-default=>$selected_dbLayout); 510 foreach my $dbLayout (@dbLayouts) { 511 my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout}) 512 ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout} 513 : "$dbLayout - no description provided in global.conf"; 514 print CGI::Tr({}, 515 CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}), 516 CGI::td($dbLayoutLabel), 517 ); 518 } 519 print CGI::end_table(); 520 print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course")); 521 522 print CGI::end_form(); 523 } 524 525 sub add_course_validate { 526 my ($self) = @_; 527 my $r = $self->r; 528 my $ce = $r->ce; 529 #my $db = $r->db; 530 #my $authz = $r->authz; 531 #my $urlpath = $r->urlpath; 532 533 my $add_courseID = $r->param("add_courseID") || ""; 534 my $add_courseTitle = $r->param("add_courseTitle") || ""; 535 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 536 537 my $add_admin_users = $r->param("add_admin_users") || ""; 538 539 my $add_initial_userID = $r->param("add_initial_userID") || ""; 540 my $add_initial_password = $r->param("add_initial_password") || ""; 541 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 542 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 543 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 544 my $add_initial_email = $r->param("add_initial_email") || ""; 545 546 my $add_templates_course = $r->param("add_templates_course") || ""; 547 548 my $add_dbLayout = $r->param("add_dbLayout") || ""; 549 550 my @errors; 551 552 if ($add_courseID eq "") { 553 push @errors, "You must specify a course ID."; 554 } 555 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 556 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 557 } 558 if (grep { $add_courseID eq $_ } listCourses($ce)) { 559 push @errors, "A course with ID $add_courseID already exists."; 560 } 561 #if ($add_courseTitle eq "") { 562 # push @errors, "You must specify a course title."; 563 #} 564 #if ($add_courseInstitution eq "") { 565 # push @errors, "You must specify an institution for this course."; 566 #} 567 568 if ($add_initial_userID ne "") { 569 if ($add_initial_password eq "") { 570 push @errors, "You must specify a password for the initial instructor."; 571 } 572 if ($add_initial_confirmPassword eq "") { 573 push @errors, "You must confirm the password for the initial instructor."; 574 } 575 if ($add_initial_password ne $add_initial_confirmPassword) { 576 push @errors, "The password and password confirmation for the instructor must match."; 577 } 578 if ($add_initial_firstName eq "") { 579 push @errors, "You must specify a first name for the initial instructor."; 580 } 581 if ($add_initial_lastName eq "") { 582 push @errors, "You must specify a last name for the initial instructor."; 583 } 584 if ($add_initial_email eq "") { 585 push @errors, "You must specify an email address for the initial instructor."; 586 } 587 } 588 589 if ($add_dbLayout eq "") { 590 push @errors, "You must select a database layout."; 591 } else { 592 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 593 # we used to check for layout-specific fields here, but there aren't any layouts that require them 594 # anymore. (in the future, we'll probably deal with this in layout-specific modules.) 595 } else { 596 push @errors, "The database layout $add_dbLayout doesn't exist."; 597 } 598 } 599 600 return @errors; 601 } 602 603 sub do_add_course { 604 my ($self) = @_; 605 my $r = $self->r; 606 my $ce = $r->ce; 607 my $db = $r->db; 608 my $authz = $r->authz; 609 my $urlpath = $r->urlpath; 610 611 my $add_courseID = $r->param("add_courseID") || ""; 612 my $add_courseTitle = $r->param("add_courseTitle") || ""; 613 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 614 615 my $add_admin_users = $r->param("add_admin_users") || ""; 616 617 my $add_initial_userID = $r->param("add_initial_userID") || ""; 618 my $add_initial_password = $r->param("add_initial_password") || ""; 619 my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || ""; 620 my $add_initial_firstName = $r->param("add_initial_firstName") || ""; 621 my $add_initial_lastName = $r->param("add_initial_lastName") || ""; 622 my $add_initial_email = $r->param("add_initial_email") || ""; 623 624 my $add_templates_course = $r->param("add_templates_course") || ""; 625 626 my $add_dbLayout = $r->param("add_dbLayout") || ""; 627 628 my $ce2 = WeBWorK::CourseEnvironment->new( 629 $ce->{webworkDirs}->{root}, 630 $ce->{webworkURLs}->{root}, 631 $ce->{pg}->{directories}->{root}, 632 $add_courseID, 633 ); 634 635 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 636 637 if ($add_initial_email ne "") { 638 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 639 # don't set feedbackRecipients -- this just gets in the way of the more 640 # intelligent "receive_recipients" method. 641 #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; 642 } 643 644 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 645 # below this line, we would grab values from getopt and put them in this hash 646 # but for now the hash can remain empty 647 my %dbOptions; 648 649 my @users; 650 651 # copy users from current (admin) course if desired 652 if ($add_admin_users ne "") { 653 foreach my $userID ($db->listUsers) { 654 if ($userID eq $add_initial_userID) { 655 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor."); 656 next; 657 } 658 my $User = $db->getUser($userID); 659 my $Password = $db->getPassword($userID); 660 my $PermissionLevel = $db->getPermissionLevel($userID); 661 push @users, [ $User, $Password, $PermissionLevel ] 662 if $authz->hasPermissions($userID,"create_and_delete_courses"); 663 #only transfer the "instructors" in the admin course classlist. 664 } 665 } 666 667 # add initial instructor if desired 668 if ($add_initial_userID ne "") { 669 my $User = $db->newUser( 670 user_id => $add_initial_userID, 671 first_name => $add_initial_firstName, 672 last_name => $add_initial_lastName, 673 student_id => $add_initial_userID, 674 email_address => $add_initial_email, 675 status => "C", 676 ); 677 my $Password = $db->newPassword( 678 user_id => $add_initial_userID, 679 password => cryptPassword($add_initial_password), 680 ); 681 my $PermissionLevel = $db->newPermissionLevel( 682 user_id => $add_initial_userID, 683 permission => "10", 684 ); 685 push @users, [ $User, $Password, $PermissionLevel ]; 686 } 687 688 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users; 689 690 my %optional_arguments; 691 if ($add_templates_course ne "") { 692 $optional_arguments{templatesFrom} = $add_templates_course; 693 } 694 695 eval { 696 addCourse( 697 courseID => $add_courseID, 698 ce => $ce2, 699 courseOptions => \%courseOptions, 700 dbOptions => \%dbOptions, 701 users => \@users, 702 %optional_arguments, 703 ); 704 }; 705 if ($@) { 706 my $error = $@; 707 print CGI::div({class=>"ResultsWithError"}, 708 CGI::p("An error occured while creating the course $add_courseID:"), 709 CGI::tt(CGI::escapeHTML($error)), 710 ); 711 # get rid of any partially built courses 712 # FIXME -- this is too fragile 713 unless ($error =~ /course exists/) { 714 eval { 715 deleteCourse( 716 courseID => $add_courseID, 717 ce => $ce2, 718 dbOptions => \%dbOptions, 719 ); 720 } 721 } 722 } else { 723 #log the action 724 writeLog($ce, "hosted_courses", join("\t", 725 "\tAdded", 726 ( defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)" ), 727 ( defined $add_courseTitle ? $add_courseTitle : "(no title specified)" ), 728 $add_courseID, 729 $add_initial_firstName, 730 $add_initial_lastName, 731 $add_initial_email, 732 )); 733 # add contact to admin course as student? 734 # FIXME -- should we do this? 735 if ($add_initial_userID ne "") { 736 my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact 737 my $User = $db->newUser( 738 user_id => $composite_id, # student id includes school name and contact 739 first_name => $add_initial_firstName, 740 last_name => $add_initial_lastName, 741 student_id => $add_initial_userID, 742 email_address => $add_initial_email, 743 status => "C", 744 ); 745 my $Password = $db->newPassword( 746 user_id => $composite_id, 747 password => cryptPassword($add_initial_password), 748 ); 749 my $PermissionLevel = $db->newPermissionLevel( 750 user_id => $composite_id, 751 permission => "0", 752 ); 753 # add contact to admin course as student 754 # or if this contact and course already exist in a dropped status 755 # change the student's status to enrolled 756 if (my $oldUser = $db->getUser($composite_id) ) { 757 warn "Replacing old data for $composite_id status: ". $oldUser->status; 758 $db->deleteUser($composite_id); 759 } 760 eval { $db->addUser($User) }; warn $@ if $@; 761 eval { $db->addPassword($Password) }; warn $@ if $@; 762 eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; 763 } 764 print CGI::div({class=>"ResultsWithoutError"}, 765 CGI::p("Successfully created the course $add_courseID"), 766 ); 767 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 768 courseID => $add_courseID); 769 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 770 print CGI::div({style=>"text-align: center"}, 771 CGI::a({href=>$newCourseURL}, "Log into $add_courseID"), 772 ); 773 } 774 775 776 } 777 778 ################################################################################ 779 780 sub rename_course_form { 781 my ($self) = @_; 782 my $r = $self->r; 783 my $ce = $r->ce; 784 #my $db = $r->db; 785 #my $authz = $r->authz; 786 #my $urlpath = $r->urlpath; 787 788 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 789 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 790 791 my @courseIDs = listCourses($ce); 792 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; 793 794 my %courseLabels; # records... heh. 795 foreach my $courseID (@courseIDs) { 796 my $tempCE = WeBWorK::CourseEnvironment->new( 797 $ce->{webworkDirs}->{root}, 798 $ce->{webworkURLs}->{root}, 799 $ce->{pg}->{directories}->{root}, 800 $courseID, 801 ); 802 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 803 } 804 805 print CGI::h2("Rename Course"); 806 807 print CGI::start_form(-method=>"POST", -action=>$r->uri); 808 print $self->hidden_authen_fields; 809 print $self->hidden_fields("subDisplay"); 810 811 print CGI::p("Select a course to rename."); 812 813 print CGI::table({class=>"FormLayout"}, 814 CGI::Tr({}, 815 CGI::th({class=>"LeftHeader"}, "Course Name:"), 816 CGI::td( 817 CGI::scrolling_list( 818 -name => "rename_oldCourseID", 819 -values => \@courseIDs, 820 -default => $rename_oldCourseID, 821 -size => 10, 822 -multiple => 0, 823 -labels => \%courseLabels, 824 ), 825 ), 826 ), 827 CGI::Tr({}, 828 CGI::th({class=>"LeftHeader"}, "New Name:"), 829 CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)), 830 ), 831 ); 832 833 print CGI::end_table(); 834 835 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course")); 836 837 print CGI::end_form(); 838 } 839 840 sub rename_course_validate { 841 my ($self) = @_; 842 my $r = $self->r; 843 my $ce = $r->ce; 844 #my $db = $r->db; 845 #my $authz = $r->authz; 846 #my $urlpath = $r->urlpath; 847 848 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 849 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 850 851 my @errors; 852 853 if ($rename_oldCourseID eq "") { 854 push @errors, "You must select a course to rename."; 855 } 856 if ($rename_newCourseID eq "") { 857 push @errors, "You must specify a new name for the course."; 858 } 859 if ($rename_oldCourseID eq $rename_newCourseID) { 860 push @errors, "Can't rename to the same name."; 861 } 862 unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm 863 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores."; 864 } 865 if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { 866 push @errors, "A course with ID $rename_newCourseID already exists."; 867 } 868 869 my $ce2 = WeBWorK::CourseEnvironment->new( 870 $ce->{webworkDirs}->{root}, 871 $ce->{webworkURLs}->{root}, 872 $ce->{pg}->{directories}->{root}, 873 $rename_oldCourseID, 874 ); 875 876 return @errors; 877 } 878 879 sub do_rename_course { 880 my ($self) = @_; 881 my $r = $self->r; 882 my $ce = $r->ce; 883 my $db = $r->db; 884 #my $authz = $r->authz; 885 my $urlpath = $r->urlpath; 886 887 my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; 888 my $rename_newCourseID = $r->param("rename_newCourseID") || ""; 889 890 my $ce2 = WeBWorK::CourseEnvironment->new( 891 $ce->{webworkDirs}->{root}, 892 $ce->{webworkURLs}->{root}, 893 $ce->{pg}->{directories}->{root}, 894 $rename_oldCourseID, 895 ); 896 897 my $dbLayoutName = $ce->{dbLayoutName}; 898 899 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 900 # below this line, we would grab values from getopt and put them in this hash 901 # but for now the hash can remain empty 902 my %dbOptions; 903 904 eval { 905 renameCourse( 906 courseID => $rename_oldCourseID, 907 ce => $ce2, 908 dbOptions => \%dbOptions, 909 newCourseID => $rename_newCourseID, 910 ); 911 }; 912 if ($@) { 913 my $error = $@; 914 print CGI::div({class=>"ResultsWithError"}, 915 CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"), 916 CGI::tt(CGI::escapeHTML($error)), 917 ); 918 } else { 919 print CGI::div({class=>"ResultsWithoutError"}, 920 CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"), 921 ); 922 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 923 courseID => $rename_newCourseID); 924 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 925 print CGI::div({style=>"text-align: center"}, 926 CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"), 927 ); 928 } 929 } 930 931 ################################################################################ 932 933 sub delete_course_form { 934 my ($self) = @_; 935 my $r = $self->r; 936 my $ce = $r->ce; 937 #my $db = $r->db; 938 #my $authz = $r->authz; 939 #my $urlpath = $r->urlpath; 940 941 my $delete_courseID = $r->param("delete_courseID") || ""; 942 943 my @courseIDs = listCourses($ce); 944 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 945 946 my %courseLabels; # records... heh. 947 foreach my $courseID (@courseIDs) { 948 my $tempCE = WeBWorK::CourseEnvironment->new( 949 $ce->{webworkDirs}->{root}, 950 $ce->{webworkURLs}->{root}, 951 $ce->{pg}->{directories}->{root}, 952 $courseID, 953 ); 954 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 955 } 956 957 print CGI::h2("Delete Course"); 958 959 print CGI::start_form(-method=>"POST", -action=>$r->uri); 960 print $self->hidden_authen_fields; 961 print $self->hidden_fields("subDisplay"); 962 963 print CGI::p("Select a course to delete."); 964 965 print CGI::table({class=>"FormLayout"}, 966 CGI::Tr({}, 967 CGI::th({class=>"LeftHeader"}, "Course Name:"), 968 CGI::td( 969 CGI::scrolling_list( 970 -name => "delete_courseID", 971 -values => \@courseIDs, 972 -default => $delete_courseID, 973 -size => 10, 974 -multiple => 0, 975 -labels => \%courseLabels, 976 ), 977 ), 978 ), 979 ); 980 981 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course")); 982 983 print CGI::end_form(); 984 } 985 986 sub delete_course_validate { 987 my ($self) = @_; 988 my $r = $self->r; 989 my $ce = $r->ce; 990 #my $db = $r->db; 991 #my $authz = $r->authz; 992 my $urlpath = $r->urlpath; 993 994 my $delete_courseID = $r->param("delete_courseID") || ""; 995 996 my @errors; 997 998 if ($delete_courseID eq "") { 999 push @errors, "You must specify a course name."; 1000 } elsif ($delete_courseID eq $urlpath->arg("courseID")) { 1001 push @errors, "You cannot delete the course you are currently using."; 1002 } 1003 1004 my $ce2 = WeBWorK::CourseEnvironment->new( 1005 $ce->{webworkDirs}->{root}, 1006 $ce->{webworkURLs}->{root}, 1007 $ce->{pg}->{directories}->{root}, 1008 $delete_courseID, 1009 ); 1010 1011 return @errors; 1012 } 1013 1014 sub delete_course_confirm { 1015 my ($self) = @_; 1016 my $r = $self->r; 1017 my $ce = $r->ce; 1018 #my $db = $r->db; 1019 #my $authz = $r->authz; 1020 #my $urlpath = $r->urlpath; 1021 1022 print CGI::h2("Delete Course"); 1023 1024 my $delete_courseID = $r->param("delete_courseID") || ""; 1025 1026 my $ce2 = WeBWorK::CourseEnvironment->new( 1027 $ce->{webworkDirs}->{root}, 1028 $ce->{webworkURLs}->{root}, 1029 $ce->{pg}->{directories}->{root}, 1030 $delete_courseID, 1031 ); 1032 1033 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1034 . "? All course files and data will be destroyed. There is no undo available."); 1035 1036 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1037 print $self->hidden_authen_fields; 1038 print $self->hidden_fields("subDisplay"); 1039 print $self->hidden_fields(qw/delete_courseID/); 1040 1041 print CGI::p({style=>"text-align: center"}, 1042 CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"), 1043 " ", 1044 CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"), 1045 ); 1046 1047 print CGI::end_form(); 1048 } 1049 1050 sub do_delete_course { 1051 my ($self) = @_; 1052 my $r = $self->r; 1053 my $ce = $r->ce; 1054 my $db = $r->db; 1055 #my $authz = $r->authz; 1056 #my $urlpath = $r->urlpath; 1057 1058 my $delete_courseID = $r->param("delete_courseID") || ""; 1059 1060 my $ce2 = WeBWorK::CourseEnvironment->new( 1061 $ce->{webworkDirs}->{root}, 1062 $ce->{webworkURLs}->{root}, 1063 $ce->{pg}->{directories}->{root}, 1064 $delete_courseID, 1065 ); 1066 1067 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts 1068 # below this line, we would grab values from getopt and put them in this hash 1069 # but for now the hash can remain empty 1070 my %dbOptions; 1071 1072 eval { 1073 deleteCourse( 1074 courseID => $delete_courseID, 1075 ce => $ce2, 1076 dbOptions => \%dbOptions, 1077 ); 1078 }; 1079 1080 if ($@) { 1081 my $error = $@; 1082 print CGI::div({class=>"ResultsWithError"}, 1083 CGI::p("An error occured while deleting the course $delete_courseID:"), 1084 CGI::tt(CGI::escapeHTML($error)), 1085 ); 1086 } else { 1087 # mark the contact person in the admin course as dropped. 1088 # find the contact person for the course by searching the admin classlist. 1089 my @contacts = grep /_$delete_courseID$/, $db->listUsers; 1090 if (@contacts) { 1091 die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1; 1092 #warn "contacts", join(" ", @contacts); 1093 #my $composite_id = "${add_initial_userID}_${add_courseID}"; 1094 my $composite_id = $contacts[0]; 1095 1096 # mark the contact person as dropped. 1097 my $User = $db->getUser($composite_id); 1098 my $status_name = 'Drop'; 1099 my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; 1100 $User->status($status_value); 1101 $db->putUser($User); 1102 } 1103 1104 print CGI::div({class=>"ResultsWithoutError"}, 1105 CGI::p("Successfully deleted the course $delete_courseID."), 1106 ); 1107 writeLog($ce, "hosted_courses", join("\t", 1108 "\tDeleted", 1109 "", 1110 "", 1111 $delete_courseID, 1112 )); 1113 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1114 print $self->hidden_authen_fields; 1115 print $self->hidden_fields("subDisplay"); 1116 1117 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),); 1118 1119 print CGI::end_form(); 1120 } 1121 } 1122 1123 ################################################################################ 1124 1125 sub export_database_form { 1126 my ($self) = @_; 1127 my $r = $self->r; 1128 my $ce = $r->ce; 1129 #my $db = $r->db; 1130 #my $authz = $r->authz; 1131 #my $urlpath = $r->urlpath; 1132 1133 my @tables = keys %{$ce->{dbLayout}}; 1134 1135 my $export_courseID = $r->param("export_courseID") || ""; 1136 my @export_tables = $r->param("export_tables"); 1137 1138 @export_tables = @tables unless @export_tables; 1139 1140 my @courseIDs = listCourses($ce); 1141 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1142 1143 my %courseLabels; # records... heh. 1144 foreach my $courseID (@courseIDs) { 1145 my $tempCE = WeBWorK::CourseEnvironment->new( 1146 $ce->{webworkDirs}->{root}, 1147 $ce->{webworkURLs}->{root}, 1148 $ce->{pg}->{directories}->{root}, 1149 $courseID, 1150 ); 1151 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1152 } 1153 1154 print CGI::h2("Export Database"); 1155 1156 print CGI::p(IMPORT_EXPORT_WARNING); 1157 1158 print CGI::start_form(-method=>"GET", -action=>$r->uri); 1159 print $self->hidden_authen_fields; 1160 print $self->hidden_fields("subDisplay"); 1161 1162 print CGI::p({},"Select a course to export the course's database. Please note 1163 that exporting can take a very long time for a large course. If you have 1164 shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), " 1165 utility instead."); 1166 1167 print CGI::table({class=>"FormLayout"}, 1168 CGI::Tr({}, 1169 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1170 CGI::td( 1171 CGI::scrolling_list( 1172 -name => "export_courseID", 1173 -values => \@courseIDs, 1174 -default => $export_courseID, 1175 -size => 10, 1176 -multiple => 1, 1177 -labels => \%courseLabels, 1178 ), 1179 ), 1180 ), 1181 CGI::Tr({}, 1182 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1183 CGI::td({}, 1184 CGI::checkbox_group( 1185 -name => "export_tables", 1186 -values => \@tables, 1187 -default => \@export_tables, 1188 -linebreak => 1, 1189 ), 1190 ), 1191 ), 1192 ); 1193 1194 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database")); 1195 1196 print CGI::end_form(); 1197 } 1198 1199 sub export_database_validate { 1200 my ($self) = @_; 1201 my $r = $self->r; 1202 #my $ce = $r->ce; 1203 #my $db = $r->db; 1204 #my $authz = $r->authz; 1205 #my $urlpath = $r->urlpath; 1206 1207 my @export_courseID = $r->param("export_courseID") || (); 1208 my @export_tables = $r->param("export_tables"); 1209 1210 my @errors; 1211 1212 unless ( @export_courseID) { 1213 push @errors, "You must specify at least one course name."; 1214 } 1215 1216 unless (@export_tables) { 1217 push @errors, "You must specify at least one table to export."; 1218 } 1219 1220 return @errors; 1221 } 1222 1223 sub do_export_database { 1224 my ($self) = @_; 1225 my $r = $self->r; 1226 my $ce = $r->ce; 1227 #my $db = $r->db; 1228 #my $authz = $r->authz; 1229 my $urlpath = $r->urlpath; 1230 1231 my @export_courseID = $r->param("export_courseID"); 1232 my @export_tables = $r->param("export_tables"); 1233 1234 foreach my $export_courseID (@export_courseID) { 1235 1236 my $ce2 = WeBWorK::CourseEnvironment->new( 1237 $ce->{webworkDirs}->{root}, 1238 $ce->{webworkURLs}->{root}, 1239 $ce->{pg}->{directories}->{root}, 1240 $export_courseID, 1241 ); 1242 1243 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1244 1245 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1246 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1247 # export to the admin/templates directory 1248 my $exportFileName = "$export_courseID.exported.xml"; 1249 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName"; 1250 # get a unique name 1251 my $number =1; 1252 while (-e "$exportFilePath.$number.gz") { 1253 $number++; 1254 last if $number>9; 1255 } 1256 if ($number<=9 ) { 1257 $exportFilePath = "$exportFilePath.$number"; 1258 $exportFileName = "$exportFileName.$number"; 1259 } else { 1260 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please 1261 remove some of these files.")); 1262 $exportFilePath = "$exportFilePath.999"; 1263 $exportFileName = "$exportFileName.999"; 1264 } 1265 1266 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath"; 1267 1268 my @errors; 1269 eval { 1270 @errors = dbExport( 1271 db => $db2, 1272 #xml => $fh, 1273 xml => $outputFileHandle, 1274 tables => \@export_tables, 1275 ); 1276 }; 1277 1278 $outputFileHandle->close(); 1279 1280 my $gzipMessage = system( 'gzip', $exportFilePath); 1281 if ( !$gzipMessage ) { 1282 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip. 1283 You may download it with the file manager.")); 1284 } else { 1285 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath")); 1286 } 1287 unlink $exportFilePath; 1288 } # end export of one course 1289 #push @errors, "Fatal exception: $@" if $@; 1290 # 1291 #if (@errors) { 1292 # print CGI::div({class=>"ResultsWithError"}, 1293 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1294 # CGI::ul(CGI::li(\@errors)), 1295 # ); 1296 #} else { 1297 # print CGI::div({class=>"ResultsWithoutError"}, 1298 # CGI::p("Export succeeded."), 1299 # ); 1300 # 1301 # print CGI::div({style=>"text-align: center"}, 1302 # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"), 1303 # ); 1304 #} 1305 } 1306 1307 ################################################################################ 1308 1309 sub import_database_form { 1310 my ($self) = @_; 1311 my $r = $self->r; 1312 my $ce = $r->ce; 1313 #my $db = $r->db; 1314 #my $authz = $r->authz; 1315 #my $urlpath = $r->urlpath; 1316 1317 my @tables = keys %{$ce->{dbLayout}}; 1318 1319 my $import_file = $r->param("import_file") || ""; 1320 my $import_courseID = $r->param("import_courseID") || ""; 1321 my @import_tables = $r->param("import_tables"); 1322 my $import_conflict = $r->param("import_conflict") || "skip"; 1323 1324 @import_tables = @tables unless @import_tables; 1325 1326 my @courseIDs = listCourses($ce); 1327 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1328 1329 1330 my %courseLabels; # records... heh. 1331 foreach my $courseID (@courseIDs) { 1332 my $tempCE = WeBWorK::CourseEnvironment->new( 1333 $ce->{webworkDirs}->{root}, 1334 $ce->{webworkURLs}->{root}, 1335 $ce->{pg}->{directories}->{root}, 1336 $courseID, 1337 ); 1338 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1339 } 1340 1341 # find databases: 1342 my $templatesDir = $ce->{courseDirs}->{templates}; 1343 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} }; 1344 my $exempt_dirs = join("|", keys %probLibs); 1345 1346 my @databaseFiles = listFilesRecursive( 1347 $templatesDir, 1348 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!! 1349 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories 1350 0, # match against file name only 1351 1, # prune against path relative to $templatesDir 1352 ); 1353 1354 my %databaseLabels = map { ($_ => $_) } @databaseFiles; 1355 1356 ####### 1357 1358 print CGI::h2("Import Database"); 1359 1360 print CGI::p(IMPORT_EXPORT_WARNING); 1361 1362 print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART); 1363 print $self->hidden_authen_fields; 1364 print $self->hidden_fields("subDisplay"); 1365 1366 print CGI::table({class=>"FormLayout"}, 1367 CGI::Tr({}, 1368 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1369 CGI::td( 1370 CGI::scrolling_list( 1371 -name => "import_file", 1372 -values => \@databaseFiles, 1373 -default => undef, 1374 -size => 10, 1375 -multiple => 0, 1376 -labels => \%databaseLabels, 1377 ), 1378 1379 ) 1380 ), 1381 CGI::Tr({}, 1382 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1383 CGI::td( 1384 CGI::checkbox_group( 1385 -name => "import_tables", 1386 -values => \@tables, 1387 -default => \@import_tables, 1388 -linebreak => 1, 1389 ), 1390 ), 1391 ), 1392 CGI::Tr({}, 1393 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1394 CGI::td( 1395 CGI::scrolling_list( 1396 -name => "import_courseID", 1397 -values => \@courseIDs, 1398 -default => $import_courseID, 1399 -size => 10, 1400 -multiple => 0, 1401 -labels => \%courseLabels, 1402 ), 1403 ), 1404 ), 1405 CGI::Tr({}, 1406 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1407 CGI::td( 1408 CGI::radio_group( 1409 -name => "import_conflict", 1410 -values => [qw/skip replace/], 1411 -default => $import_conflict, 1412 -linebreak=>'true', 1413 -labels => { 1414 skip => "Skip duplicate records", 1415 replace => "Replace duplicate records", 1416 }, 1417 ), 1418 ), 1419 ), 1420 ); 1421 1422 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database")); 1423 1424 print CGI::end_form(); 1425 } 1426 1427 sub import_database_validate { 1428 my ($self) = @_; 1429 my $r = $self->r; 1430 #my $ce = $r->ce; 1431 #my $db = $r->db; 1432 #my $authz = $r->authz; 1433 #my $urlpath = $r->urlpath; 1434 1435 my $import_file = $r->param("import_file") || ""; 1436 my $import_courseID = $r->param("import_courseID") || ""; 1437 my @import_tables = $r->param("import_tables"); 1438 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1439 1440 my @errors; 1441 1442 if ($import_file eq "") { 1443 push @errors, "You must specify a database file to import."; 1444 } 1445 1446 if ($import_courseID eq "") { 1447 push @errors, "You must specify a course name."; 1448 } 1449 1450 unless (@import_tables) { 1451 push @errors, "You must specify at least one table to import."; 1452 } 1453 1454 return @errors; 1455 } 1456 1457 sub do_import_database { 1458 my ($self) = @_; 1459 my $r = $self->r; 1460 my $ce = $r->ce; 1461 #my $db = $r->db; 1462 #my $authz = $r->authz; 1463 my $urlpath = $r->urlpath; 1464 1465 my $import_file = $r->param("import_file"); 1466 my $import_courseID = $r->param("import_courseID"); 1467 my @import_tables = $r->param("import_tables"); 1468 my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above 1469 1470 my $ce2 = WeBWorK::CourseEnvironment->new( 1471 $ce->{webworkDirs}->{root}, 1472 $ce->{webworkURLs}->{root}, 1473 $ce->{pg}->{directories}->{root}, 1474 $import_courseID, 1475 ); 1476 1477 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1478 1479 # locate file 1480 my $templateDir = $ce->{courseDirs}->{templates}; 1481 my $filePath = "$templateDir/$import_file"; 1482 1483 my $gunzipMessage = system( 'gunzip', $filePath); 1484 #FIXME 1485 #warn "gunzip ", $gunzipMessage; 1486 $filePath =~ s/\.gz$//; 1487 #warn "new file path is $filePath"; 1488 my $fileHandle = new IO::File("<$filePath"); 1489 # retrieve upload from upload cache 1490 # my ($id, $hash) = split /\s+/, $import_file; 1491 # my $upload = WeBWorK::Upload->retrieve($id, $hash, 1492 # dir => $ce->{webworkDirs}->{uploadCache} 1493 # ); 1494 1495 my @errors; 1496 1497 eval { 1498 @errors = dbImport( 1499 db => $db2, 1500 # xml => $upload->fileHandle, 1501 xml => $fileHandle, 1502 tables => \@import_tables, 1503 conflict => $import_conflict, 1504 ); 1505 }; 1506 1507 push @errors, "Fatal exception: $@" if $@; 1508 push @errors, $gunzipMessage if $gunzipMessage; 1509 1510 if (@errors) { 1511 print CGI::div({class=>"ResultsWithError"}, 1512 CGI::p("An error occured while importing the database of course $import_courseID:"), 1513 CGI::ul(CGI::li(\@errors)), 1514 ); 1515 } else { 1516 print CGI::div({class=>"ResultsWithoutError"}, 1517 CGI::p("Import succeeded."), 1518 ); 1519 } 1520 } 1521 ########################################################################## 1522 sub archive_course_form { 1523 my ($self) = @_; 1524 my $r = $self->r; 1525 my $ce = $r->ce; 1526 #my $db = $r->db; 1527 #my $authz = $r->authz; 1528 #my $urlpath = $r->urlpath; 1529 1530 my $archive_courseID = $r->param("archive_courseID") || ""; 1531 1532 my @courseIDs = listCourses($ce); 1533 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1534 1535 my %courseLabels; # records... heh. 1536 foreach my $courseID (@courseIDs) { 1537 my $tempCE = WeBWorK::CourseEnvironment->new( 1538 $ce->{webworkDirs}->{root}, 1539 $ce->{webworkURLs}->{root}, 1540 $ce->{pg}->{directories}->{root}, 1541 $courseID, 1542 ); 1543 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1544 } 1545 1546 print CGI::h2("archive Course"); 1547 1548 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1549 print $self->hidden_authen_fields; 1550 print $self->hidden_fields("subDisplay"); 1551 1552 print CGI::p("Select a course to archive."); 1553 1554 print CGI::table({class=>"FormLayout"}, 1555 CGI::Tr({}, 1556 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1557 CGI::td( 1558 CGI::scrolling_list( 1559 -name => "archive_courseID", 1560 -values => \@courseIDs, 1561 -default => $archive_courseID, 1562 -size => 10, 1563 -multiple => 0, 1564 -labels => \%courseLabels, 1565 ), 1566 ), 1567 1568 ), 1569 CGI::Tr({}, 1570 CGI::th({class=>"LeftHeader"}, "Delete course:"), 1571 CGI::td({-style=>'color:red'}, CGI::checkbox({ 1572 -name=>'delete_course', 1573 -checked=>0, 1574 -value => 1, 1575 -label =>'Delete course after archiving. Caution there is no undo!', 1576 }, 1577 ), 1578 ), 1579 ) 1580 ); 1581 1582 print CGI::p( 1583 "Currently the archive facility is only available for mysql databases. 1584 It depends on the mysqldump application." 1585 ); 1586 1587 1588 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course", -value=>"archive Course")); 1589 1590 print CGI::end_form(); 1591 } 1592 1593 sub archive_course_validate { 1594 my ($self) = @_; 1595 my $r = $self->r; 1596 my $ce = $r->ce; 1597 #my $db = $r->db; 1598 #my $authz = $r->authz; 1599 my $urlpath = $r->urlpath; 1600 1601 my $archive_courseID = $r->param("archive_courseID") || ""; 1602 1603 my @errors; 1604 1605 if ($archive_courseID eq "") { 1606 push @errors, "You must specify a course name."; 1607 } elsif ($archive_courseID eq $urlpath->arg("courseID")) { 1608 push @errors, "You cannot archive the course you are currently using."; 1609 } 1610 1611 #my $ce2 = WeBWorK::CourseEnvironment->new( 1612 # $ce->{webworkDirs}->{root}, 1613 # $ce->{webworkURLs}->{root}, 1614 # $ce->{pg}->{directories}->{root}, 1615 # $archive_courseID, 1616 #); 1617 1618 return @errors; 1619 } 1620 1621 sub archive_course_confirm { 1622 my ($self) = @_; 1623 my $r = $self->r; 1624 my $ce = $r->ce; 1625 #my $db = $r->db; 1626 #my $authz = $r->authz; 1627 #my $urlpath = $r->urlpath; 1628 1629 print CGI::h2("archive Course"); 1630 1631 my $archive_courseID = $r->param("archive_courseID") || ""; 1632 my $delete_course_flag = $r->param("delete_course") || ""; 1633 1634 my $ce2 = WeBWorK::CourseEnvironment->new( 1635 $ce->{webworkDirs}->{root}, 1636 $ce->{webworkURLs}->{root}, 1637 $ce->{pg}->{directories}->{root}, 1638 $archive_courseID, 1639 ); 1640 1641 if ($ce2->{dbLayoutName} ) { 1642 print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID) 1643 . "? "); 1644 print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ". 1645 CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag; 1646 1647 1648 } 1649 1650 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1651 print $self->hidden_authen_fields; 1652 print $self->hidden_fields("subDisplay"); 1653 print $self->hidden_fields(qw/archive_courseID delete_course/); 1654 1655 print CGI::p({style=>"text-align: center"}, 1656 CGI::submit(-name=>"decline_archive_course", -value=>"Don't archive"), 1657 " ", 1658 CGI::submit(-name=>"confirm_archive_course", -value=>"archive"), 1659 ); 1660 1661 print CGI::end_form(); 1662 } 1663 1664 sub do_archive_course { 1665 my ($self) = @_; 1666 my $r = $self->r; 1667 my $ce = $r->ce; 1668 my $db = $r->db; 1669 #my $authz = $r->authz; 1670 #my $urlpath = $r->urlpath; 1671 1672 my $archive_courseID = $r->param("archive_courseID") || ""; 1673 my $delete_course_flag = $r->param("delete_course") || ""; 1674 1675 my $ce2 = WeBWorK::CourseEnvironment->new( 1676 $ce->{webworkDirs}->{root}, 1677 $ce->{webworkURLs}->{root}, 1678 $ce->{pg}->{directories}->{root}, 1679 $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 sub unarchive_course_form { 1764 my ($self) = @_; 1765 my $r = $self->r; 1766 my $ce = $r->ce; 1767 #my $db = $r->db; 1768 #my $authz = $r->authz; 1769 #my $urlpath = $r->urlpath; 1770 1771 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 1772 1773 # First find courses which have been archived. 1774 my @courseIDs = listArchivedCourses($ce); 1775 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive 1776 1777 my %courseLabels; # records... heh. 1778 foreach my $courseID (@courseIDs) { 1779 $courseLabels{$courseID} = $courseID; 1780 } 1781 1782 print CGI::h2("Unarchive Course -- not yet operational"); 1783 1784 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1785 print $self->hidden_authen_fields; 1786 print $self->hidden_fields("subDisplay"); 1787 1788 print CGI::p("Select a course to unarchive."); 1789 1790 print CGI::table({class=>"FormLayout"}, 1791 CGI::Tr({}, 1792 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1793 CGI::td( 1794 CGI::scrolling_list( 1795 -name => "unarchive_courseID", 1796 -values => \@courseIDs, 1797 -default => $unarchive_courseID, 1798 -size => 10, 1799 -multiple => 0, 1800 -labels => \%courseLabels, 1801 ), 1802 ), 1803 ), 1804 ); 1805 1806 print CGI::p( 1807 "Currently the unarchive facility is only available for mysql databases. 1808 It depends on the mysqldump application." 1809 ); 1810 1811 1812 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course")); 1813 1814 print CGI::end_form(); 1815 } 1816 1817 sub unarchive_course_validate { 1818 my ($self) = @_; 1819 my $r = $self->r; 1820 my $ce = $r->ce; 1821 #my $db = $r->db; 1822 #my $authz = $r->authz; 1823 my $urlpath = $r->urlpath; 1824 1825 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 1826 1827 my @errors; 1828 1829 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 1830 1831 if ($new_courseID eq "") { 1832 push @errors, "You must specify a course name."; 1833 } elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) { 1834 #Check that a directory for this course doesn't already exist 1835 push @errors, "A directory already exists with the name $new_courseID. 1836 You must first delete this existing course before you can unarchive."; 1837 } 1838 1839 1840 1841 return @errors; 1842 } 1843 1844 sub unarchive_course_confirm { 1845 my ($self) = @_; 1846 my $r = $self->r; 1847 my $ce = $r->ce; 1848 #my $db = $r->db; 1849 #my $authz = $r->authz; 1850 #my $urlpath = $r->urlpath; 1851 1852 print CGI::h2("Unarchive Course"); 1853 1854 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 1855 1856 my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//; 1857 1858 1859 1860 print CGI::start_form(-method=>"POST", -action=>$r->uri); 1861 print CGI::p($unarchive_courseID," to course ", 1862 CGI::input({-name=>'new_courseID', -value=>$new_courseID}) 1863 ); 1864 1865 print $self->hidden_authen_fields; 1866 print $self->hidden_fields("subDisplay"); 1867 print $self->hidden_fields(qw/unarchive_courseID/); 1868 1869 print CGI::p({style=>"text-align: center"}, 1870 CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"), 1871 " ", 1872 CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"), 1873 ); 1874 1875 print CGI::end_form(); 1876 } 1877 1878 sub do_unarchive_course { 1879 my ($self) = @_; 1880 my $r = $self->r; 1881 my $ce = $r->ce; 1882 #my $db = $r->db; 1883 #my $authz = $r->authz; 1884 my $urlpath = $r->urlpath; 1885 my $new_courseID = $r->param("new_courseID") || ""; 1886 my $unarchive_courseID = $r->param("unarchive_courseID") || ""; 1887 1888 my %dbOptions; 1889 1890 eval { 1891 unarchiveCourse( 1892 courseID => $new_courseID, 1893 archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID", 1894 ce => $ce , # $ce2, 1895 dbOptions => undef, 1896 ); 1897 }; 1898 1899 if ($@) { 1900 my $error = $@; 1901 print CGI::div({class=>"ResultsWithError"}, 1902 CGI::p("An error occured while archiving the course $unarchive_courseID:"), 1903 CGI::tt(CGI::escapeHTML($error)), 1904 ); 1905 } else { 1906 print CGI::div({class=>"ResultsWithoutError"}, 1907 CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"), 1908 ); 1909 writeLog($ce, "hosted_courses", join("\t", 1910 "\tunarchived", 1911 "", 1912 "", 1913 "$unarchive_courseID to $new_courseID", 1914 )); 1915 1916 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 1917 courseID => $new_courseID); 1918 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); 1919 print CGI::div({style=>"text-align: center"}, 1920 CGI::a({href=>$newCourseURL}, "Log into $new_courseID"), 1921 ); 1922 } 1923 } 1924 1925 ################################################################################ 1926 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |