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