[system] / branches / rel-2-4-patches / webwork-modperl / lib / WeBWorK / ContentGenerator / CourseAdmin.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-4-patches/webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2479 Revision 4357
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.23 2004/07/10 16:06:59 sh002i Exp $ 4# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.55 2006/07/28 02:13:25 sh002i Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 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 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 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. 9# version, or (b) the "Artistic License" which comes with this package.
… …
23 23
24=cut 24=cut
25 25
26use strict; 26use strict;
27use warnings; 27use warnings;
28use CGI::Pretty qw(); 28#use CGI qw(-nosticky );
29use WeBWorK::CGI;
29use Data::Dumper; 30use Data::Dumper;
30use File::Temp qw/tempfile/; 31use File::Temp qw/tempfile/;
31use WeBWorK::CourseEnvironment; 32use WeBWorK::CourseEnvironment;
33use IO::File;
34use WeBWorK::Debug;
32use WeBWorK::Utils qw(cryptPassword writeLog); 35use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
33use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses); 36use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
37 listArchivedCourses unarchiveCourse);
34use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 38use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
39
40use constant IMPORT_EXPORT_WARNING => "The ability to import and export
41databases is still under development. It seems to work but it is <b>VERY</b>
42slow on large courses. You may prefer to use webwork2/bin/wwdb or the mysql
43dump facility for archiving large courses. Please send bug reports if you find
44errors.";
35 45
36sub pre_header_initialize { 46sub pre_header_initialize {
37 my ($self) = @_; 47 my ($self) = @_;
38 my $r = $self->r; 48 my $r = $self->r;
39 my $ce = $r->ce; 49 my $ce = $r->ce;
… …
46 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 56 unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 57 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48 return; 58 return;
49 } 59 }
50 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
51 ## if the user is asking for the downloaded database... 65 ## if the user is asking for the downloaded database...
52 #if (defined $r->param("download_exported_database")) { 66 #if (defined $r->param("download_exported_database")) {
53 # my $courseID = $r->param("export_courseID"); 67 # my $courseID = $r->param("export_courseID");
54 # my $random_chars = $r->param("download_exported_database"); 68 # my $random_chars = $r->param("download_exported_database");
55 # 69 #
… …
80 } else { 94 } else {
81 $method_to_call = "do_add_course"; 95 $method_to_call = "do_add_course";
82 } 96 }
83 } else { 97 } else {
84 $method_to_call = "add_course_form"; 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";
85 } 112 }
86 } 113 }
87 114
88 elsif ($subDisplay eq "delete_course") { 115 elsif ($subDisplay eq "delete_course") {
89 if (defined $r->param("delete_course")) { 116 if (defined $r->param("delete_course")) {
… …
136 } else { 163 } else {
137 $method_to_call = "import_database_form"; 164 $method_to_call = "import_database_form";
138 } 165 }
139 } 166 }
140 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 }
141 else { 212 else {
142 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; 213 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
143 } 214 }
144 215
145 } 216 }
… …
149} 220}
150 221
151sub header { 222sub header {
152 my ($self) = @_; 223 my ($self) = @_;
153 my $method_to_call = $self->{method_to_call}; 224 my $method_to_call = $self->{method_to_call};
154 if (defined $method_to_call and $method_to_call eq "do_export_database") { 225# if (defined $method_to_call and $method_to_call eq "do_export_database") {
155 my $r = $self->r; 226# my $r = $self->r;
156 my $courseID = $r->param("export_courseID"); 227# my $courseID = $r->param("export_courseID");
157 $r->content_type("application/octet-stream"); 228# $r->content_type("application/octet-stream");
158 $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 229# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
159 $r->send_http_header; 230# $r->send_http_header;
160 } else { 231# } else {
161 $self->SUPER::header; 232 $self->SUPER::header;
162 } 233# }
163} 234}
164 235
165# sends: 236# sends:
166# 237#
167# HTTP/1.1 200 OK 238# HTTP/1.1 200 OK
… …
173 244
174sub content { 245sub content {
175 my ($self) = @_; 246 my ($self) = @_;
176 my $method_to_call = $self->{method_to_call}; 247 my $method_to_call = $self->{method_to_call};
177 if (defined $method_to_call and $method_to_call eq "do_export_database") { 248 if (defined $method_to_call and $method_to_call eq "do_export_database") {
178 print "<!-- Ϸĩ½ōú -->\n";
179 print "<!-- Those were some high-bit characters to convince Safari that we really do want this saved as a file. -->\n";
180 $self->do_export_database; 249 #$self->do_export_database;
250 $self->SUPER::content;
181 } else { 251 } else {
182 $self->SUPER::content; 252 $self->SUPER::content;
183 } 253 }
184} 254}
185 255
… …
195 265
196 # check permissions 266 # check permissions
197 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 267 unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
198 return ""; 268 return "";
199 } 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
200 283
201 print CGI::p({style=>"text-align: center"}, 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 " | ",
202 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 292 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
203 " | ", 293 " | ",
204 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 294 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
205 " | ", 295 " | ",
206 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 296 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
207 " | ", 297 " | ",
208 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 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
209 ); 306 );
210
211 print CGI::hr();
212 307
213 my @errors = @{$self->{errors}}; 308 my @errors = @{$self->{errors}};
214 my $method_to_call = $self->{method_to_call}; 309
215 310
216 if (@errors) { 311 if (@errors) {
217 print CGI::div({class=>"ResultsWithError"}, 312 print CGI::div({class=>"ResultsWithError"},
218 CGI::p("Please correct the following errors and try again:"), 313 CGI::p("Please correct the following errors and try again:"),
219 CGI::ul(CGI::li(\@errors)), 314 CGI::ul(CGI::li(\@errors)),
220 ); 315 );
221 } 316 }
222 317
223 if (defined $method_to_call and $method_to_call ne "") { 318 if (defined $method_to_call and $method_to_call ne "") {
224 $self->$method_to_call; 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
225 } 344 }
226 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 }
227 return ""; 358 return "";
228} 359}
229 360
230################################################################################ 361################################################################################
231 362
… …
251 my $add_initial_email = $r->param("add_initial_email") || ""; 382 my $add_initial_email = $r->param("add_initial_email") || "";
252 383
253 my $add_templates_course = $r->param("add_templates_course") || ""; 384 my $add_templates_course = $r->param("add_templates_course") || "";
254 385
255 my $add_dbLayout = $r->param("add_dbLayout") || ""; 386 my $add_dbLayout = $r->param("add_dbLayout") || "";
256 my $add_sql_host = $r->param("add_sql_host") || "";
257 my $add_sql_port = $r->param("add_sql_port") || "";
258 my $add_sql_username = $r->param("add_sql_username") || "";
259 my $add_sql_password = $r->param("add_sql_password") || "";
260 my $add_sql_database = $r->param("add_sql_database") || "";
261 my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
262 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
263 387
264 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 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 };
265 406
266 my $ce2 = WeBWorK::CourseEnvironment->new( 407 my $ce2 = WeBWorK::CourseEnvironment->new(
267 $ce->{webworkDirs}->{root}, 408 $ce->{webworkDirs}->{root},
268 $ce->{webworkURLs}->{root}, 409 $ce->{webworkURLs}->{root},
269 $ce->{pg}->{directories}->{root}, 410 $ce->{pg}->{directories}->{root},
270 "COURSENAME", 411 "COURSENAME",
271 ); 412 );
272 413
273 my $dbi_source = do {
274 # find the most common SQL source (stolen from CourseManagement.pm)
275 my %sources;
276 foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
277 $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
278 }
279 my $source;
280 if (keys %sources > 1) {
281 foreach my $curr (keys %sources) {
282 $source = $curr if not defined $source or
283 $sources{$curr} > $sources{$source};
284 }
285 } else {
286 ($source) = keys %sources;
287 }
288 $source;
289 };
290
291 my @existingCourses = listCourses($ce); 414 my @existingCourses = listCourses($ce);
292 @existingCourses = sort @existingCourses; 415 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
293 416
294 print CGI::h2("Add Course"); 417 print CGI::h2("Add Course");
295 418
296 print CGI::start_form("POST", $r->uri); 419 print CGI::start_form(-method=>"POST", -action=>$r->uri);
297 print $self->hidden_authen_fields; 420 print $self->hidden_authen_fields;
298 print $self->hidden_fields("subDisplay"); 421 print $self->hidden_fields("subDisplay");
299 422
300 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores."); 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.");
301 424
302 print CGI::table({class=>"FormLayout"}, 425 print CGI::table({class=>"FormLayout"},
303 CGI::Tr( 426 CGI::Tr({},
304 CGI::th({class=>"LeftHeader"}, "Course ID:"), 427 CGI::th({class=>"LeftHeader"}, "Course ID:"),
305 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)), 428 CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)),
306 ), 429 ),
307 CGI::Tr( 430 CGI::Tr({},
308 CGI::th({class=>"LeftHeader"}, "Course Title:"), 431 CGI::th({class=>"LeftHeader"}, "Course Title:"),
309 CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)), 432 CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)),
310 ), 433 ),
311 CGI::Tr( 434 CGI::Tr({},
312 CGI::th({class=>"LeftHeader"}, "Institution:"), 435 CGI::th({class=>"LeftHeader"}, "Institution:"),
313 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)), 436 CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)),
314 ), 437 ),
315 ); 438 );
316 439
317 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 440 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
318 441 my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
319 print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course")); 442 print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course"));
320 443
321 print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only numbers, letters, hyphens, and underscores."); 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");
322 446
323 print CGI::table({class=>"FormLayout"}, CGI::Tr( 447 print CGI::table({class=>"FormLayout"}, CGI::Tr({},
324 CGI::td( 448 CGI::td({},
325 CGI::table({class=>"FormLayout"}, 449 CGI::table({class=>"FormLayout"},
326 CGI::Tr( 450 CGI::Tr({},
327 CGI::th({class=>"LeftHeader"}, "User ID:"), 451 CGI::th({class=>"LeftHeader"}, "User ID:"),
328 CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)), 452 CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)),
329 ), 453 ),
330 CGI::Tr( 454 CGI::Tr({},
331 CGI::th({class=>"LeftHeader"}, "Password:"), 455 CGI::th({class=>"LeftHeader"}, "Password:"),
332 CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)), 456 CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)),
333 ), 457 ),
334 CGI::Tr( 458 CGI::Tr({},
335 CGI::th({class=>"LeftHeader"}, "Confirm Password:"), 459 CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
336 CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)), 460 CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)),
337 ), 461 ),
338 ), 462 ),
339 ), 463 ),
340 CGI::td( 464 CGI::td({},
341 CGI::table({class=>"FormLayout"}, 465 CGI::table({class=>"FormLayout"},
342 CGI::Tr( 466 CGI::Tr({},
343 CGI::th({class=>"LeftHeader"}, "First Name:"), 467 CGI::th({class=>"LeftHeader"}, "First Name:"),
344 CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)), 468 CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)),
345 ), 469 ),
346 CGI::Tr( 470 CGI::Tr({},
347 CGI::th({class=>"LeftHeader"}, "Last Name:"), 471 CGI::th({class=>"LeftHeader"}, "Last Name:"),
348 CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)), 472 CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)),
349 ), 473 ),
350 CGI::Tr( 474 CGI::Tr({},
351 CGI::th({class=>"LeftHeader"}, "Email Address:"), 475 CGI::th({class=>"LeftHeader"}, "Email Address:"),
352 CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)), 476 CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)),
353 ), 477 ),
354 ), 478 ),
355 479
356 ), 480 ),
357 )); 481 ));
358 482
359 print CGI::p("To copy problem templates from an existing course, select the course below."); 483 print CGI::p("To copy problem templates from an existing course, select the course below.");
360 484
361 print CGI::table({class=>"FormLayout"}, 485 print CGI::table({class=>"FormLayout"},
362 CGI::Tr( 486 CGI::Tr({},
363 CGI::th({class=>"LeftHeader"}, "Copy templates from:"), 487 CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
364 CGI::td( 488 CGI::td(
365 CGI::popup_menu( 489 CGI::popup_menu(
366 -name => "add_templates_course", 490 -name => "add_templates_course",
367 -values => [ "", @existingCourses ], 491 -values => [ "", @existingCourses ],
… …
373 497
374 ), 498 ),
375 ), 499 ),
376 ); 500 );
377 501
502
503
378 print CGI::p("Select a database layout below."); 504 print CGI::p("Select a database layout below.");
505 print CGI::start_table({class=>"FormLayout"});
379 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);
380 foreach my $dbLayout (@dbLayouts) { 510 foreach my $dbLayout (@dbLayouts) {
381 print CGI::start_table({class=>"FormLayout"}); 511 my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
382 512 ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
383 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 513 : "$dbLayout - no description provided in global.conf";
384 print CGI::Tr( 514 print CGI::Tr({},
385 CGI::td({style=>"text-align: right"}, 515 CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}),
386 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
387 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
388 ),
389 CGI::td($dbLayout), 516 CGI::td($dbLayoutLabel),
390 );
391
392 print CGI::start_Tr();
393 print CGI::td(); # for indentation :(
394 print CGI::start_td();
395
396 if ($dbLayout eq "sql") {
397 print CGI::start_table({class=>"FormLayout"});
398 print CGI::Tr(CGI::td({colspan=>2},
399 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
400 )
401 ); 517 );
402 print CGI::Tr(
403 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
404 CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
405 );
406 print CGI::Tr(
407 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
408 CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
409 );
410
411 print CGI::Tr(CGI::td({colspan=>2},
412 "The optionial SQL settings you enter below must match the settings in the DBI source"
413 . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
414 . " with the course name you entered above."
415 )
416 );
417 print CGI::Tr(
418 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
419 CGI::td(
420 CGI::textfield("add_sql_host", $add_sql_host, 25),
421 CGI::br(),
422 CGI::small("Leave blank to use the default host."),
423 ),
424 );
425 print CGI::Tr(
426 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
427 CGI::td(
428 CGI::textfield("add_sql_port", $add_sql_port, 25),
429 CGI::br(),
430 CGI::small("Leave blank to use the default port."),
431 ),
432 );
433
434 print CGI::Tr(
435 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
436 CGI::td(
437 CGI::textfield("add_sql_database", $add_sql_database, 25),
438 CGI::br(),
439 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
440 ),
441 );
442 print CGI::Tr(
443 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
444 CGI::td(
445 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25),
446 CGI::br(),
447 CGI::small("If the SQL server does not run on the same host as WeBWorK, enter the host name of the WeBWorK server as seen by the SQL server."),
448 ),
449 );
450 print CGI::end_table();
451 } elsif ($dbLayout eq "gdbm") {
452 print CGI::start_table({class=>"FormLayout"});
453 print CGI::Tr(
454 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
455 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)),
456 );
457 print CGI::end_table();
458 } 518 }
459
460 print CGI::end_td();
461 print CGI::end_Tr();
462 print CGI::end_table(); 519 print CGI::end_table();
463 }
464
465 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course")); 520 print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course"));
466 521
467 print CGI::end_form(); 522 print CGI::end_form();
468} 523}
469 524
470sub add_course_validate { 525sub add_course_validate {
… …
489 my $add_initial_email = $r->param("add_initial_email") || ""; 544 my $add_initial_email = $r->param("add_initial_email") || "";
490 545
491 my $add_templates_course = $r->param("add_templates_course") || ""; 546 my $add_templates_course = $r->param("add_templates_course") || "";
492 547
493 my $add_dbLayout = $r->param("add_dbLayout") || ""; 548 my $add_dbLayout = $r->param("add_dbLayout") || "";
494 my $add_sql_host = $r->param("add_sql_host") || "";
495 my $add_sql_port = $r->param("add_sql_port") || "";
496 my $add_sql_username = $r->param("add_sql_username") || "";
497 my $add_sql_password = $r->param("add_sql_password") || "";
498 my $add_sql_database = $r->param("add_sql_database") || "";
499 my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
500 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
501 549
502 my @errors; 550 my @errors;
503 551
504 if ($add_courseID eq "") { 552 if ($add_courseID eq "") {
505 push @errors, "You must specify a course ID."; 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.";
506 } 557 }
507 if (grep { $add_courseID eq $_ } listCourses($ce)) { 558 if (grep { $add_courseID eq $_ } listCourses($ce)) {
508 push @errors, "A course with ID $add_courseID already exists."; 559 push @errors, "A course with ID $add_courseID already exists.";
509 } 560 }
510 if ($add_courseTitle eq "") { 561 if ($add_courseTitle eq "") {
… …
537 588
538 if ($add_dbLayout eq "") { 589 if ($add_dbLayout eq "") {
539 push @errors, "You must select a database layout."; 590 push @errors, "You must select a database layout.";
540 } else { 591 } else {
541 if (exists $ce->{dbLayouts}->{$add_dbLayout}) { 592 if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
542 if ($add_dbLayout eq "sql") { 593 # we used to check for layout-specific fields here, but there aren't any layouts that require them
543 push @errors, "You must specify the SQL admin username." if $add_sql_username eq ""; 594 # anymore. (in the future, we'll probably deal with this in layout-specific modules.)
544 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
545 } elsif ($add_dbLayout eq "gdbm") {
546 push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
547 }
548 } else { 595 } else {
549 push @errors, "The database layout $add_dbLayout doesn't exist."; 596 push @errors, "The database layout $add_dbLayout doesn't exist.";
550 } 597 }
551 } 598 }
552 599
… …
556sub do_add_course { 603sub do_add_course {
557 my ($self) = @_; 604 my ($self) = @_;
558 my $r = $self->r; 605 my $r = $self->r;
559 my $ce = $r->ce; 606 my $ce = $r->ce;
560 my $db = $r->db; 607 my $db = $r->db;
561 #my $authz = $r->authz; 608 my $authz = $r->authz;
562 my $urlpath = $r->urlpath; 609 my $urlpath = $r->urlpath;
563 610
564 my $add_courseID = $r->param("add_courseID") || ""; 611 my $add_courseID = $r->param("add_courseID") || "";
565 my $add_courseTitle = $r->param("add_courseTitle") || ""; 612 my $add_courseTitle = $r->param("add_courseTitle") || "";
566 my $add_courseInstitution = $r->param("add_courseInstitution") || ""; 613 my $add_courseInstitution = $r->param("add_courseInstitution") || "";
… …
575 my $add_initial_email = $r->param("add_initial_email") || ""; 622 my $add_initial_email = $r->param("add_initial_email") || "";
576 623
577 my $add_templates_course = $r->param("add_templates_course") || ""; 624 my $add_templates_course = $r->param("add_templates_course") || "";
578 625
579 my $add_dbLayout = $r->param("add_dbLayout") || ""; 626 my $add_dbLayout = $r->param("add_dbLayout") || "";
580 my $add_sql_host = $r->param("add_sql_host") || "";
581 my $add_sql_port = $r->param("add_sql_port") || "";
582 my $add_sql_username = $r->param("add_sql_username") || "";
583 my $add_sql_password = $r->param("add_sql_password") || "";
584 my $add_sql_database = $r->param("add_sql_database") || "";
585 my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
586 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
587 627
588 my $ce2 = WeBWorK::CourseEnvironment->new( 628 my $ce2 = WeBWorK::CourseEnvironment->new(
589 $ce->{webworkDirs}->{root}, 629 $ce->{webworkDirs}->{root},
590 $ce->{webworkURLs}->{root}, 630 $ce->{webworkURLs}->{root},
591 $ce->{pg}->{directories}->{root}, 631 $ce->{pg}->{directories}->{root},
… …
594 634
595 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 635 my %courseOptions = ( dbLayoutName => $add_dbLayout );
596 636
597 if ($add_initial_email ne "") { 637 if ($add_initial_email ne "") {
598 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 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.
599 $courseOptions{feedbackRecipients} = [ $add_initial_email ]; 641 #$courseOptions{feedbackRecipients} = [ $add_initial_email ];
600 } 642 }
601 643
602 if ($add_dbLayout eq "gdbm") { 644 # this is kinda left over from when we had 'gdbm' and 'sql' database layouts
603 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 645 # below this line, we would grab values from getopt and put them in this hash
604 } 646 # but for now the hash can remain empty
605
606 my %dbOptions; 647 my %dbOptions;
607 if ($add_dbLayout eq "sql") {
608 $dbOptions{host} = $add_sql_host if $add_sql_host ne "";
609 $dbOptions{port} = $add_sql_port if $add_sql_port ne "";
610 $dbOptions{username} = $add_sql_username;
611 $dbOptions{password} = $add_sql_password;
612 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID";
613 $dbOptions{wwhost} = $add_sql_wwhost;
614 }
615 648
616 my @users; 649 my @users;
617 650
618 # copy users from current (admin) course if desired 651 # copy users from current (admin) course if desired
619 if ($add_admin_users ne "") { 652 if ($add_admin_users ne "") {
620 foreach my $userID ($db->listUsers) { 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 }
621 my $User = $db->getUser($userID); 658 my $User = $db->getUser($userID);
622 my $Password = $db->getPassword($userID); 659 my $Password = $db->getPassword($userID);
623 my $PermissionLevel = $db->getPermissionLevel($userID); 660 my $PermissionLevel = $db->getPermissionLevel($userID);
624 push @users, [ $User, $Password, $PermissionLevel ]; 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.
625 } 664 }
626 } 665 }
627 666
628 # add initial instructor if desired 667 # add initial instructor if desired
629 if ($add_initial_userID ne "") { 668 if ($add_initial_userID ne "") {
… …
644 permission => "10", 683 permission => "10",
645 ); 684 );
646 push @users, [ $User, $Password, $PermissionLevel ]; 685 push @users, [ $User, $Password, $PermissionLevel ];
647 } 686 }
648 687
649 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users; 688 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
650 689
651 my %optional_arguments; 690 my %optional_arguments;
652 if ($add_templates_course ne "") { 691 if ($add_templates_course ne "") {
653 $optional_arguments{templatesFrom} = $add_templates_course; 692 $optional_arguments{templatesFrom} = $add_templates_course;
654 } 693 }
… …
691 $add_initial_lastName, 730 $add_initial_lastName,
692 $add_initial_email, 731 $add_initial_email,
693 )); 732 ));
694 # add contact to admin course as student? 733 # add contact to admin course as student?
695 # FIXME -- should we do this? 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 }
696 print CGI::div({class=>"ResultsWithoutError"}, 764 print CGI::div({class=>"ResultsWithoutError"},
697 CGI::p("Successfully created the course $add_courseID"), 765 CGI::p("Successfully created the course $add_courseID"),
698 ); 766 );
699 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 767 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
700 courseID => $add_courseID); 768 courseID => $add_courseID);
… …
707 775
708} 776}
709 777
710################################################################################ 778################################################################################
711 779
712sub delete_course_form { 780sub rename_course_form {
713 my ($self) = @_; 781 my ($self) = @_;
714 my $r = $self->r; 782 my $r = $self->r;
715 my $ce = $r->ce; 783 my $ce = $r->ce;
716 #my $db = $r->db; 784 #my $db = $r->db;
717 #my $authz = $r->authz; 785 #my $authz = $r->authz;
718 #my $urlpath = $r->urlpath; 786 #my $urlpath = $r->urlpath;
719 787
720 my $delete_courseID = $r->param("delete_courseID") || ""; 788 my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
721 my $delete_sql_host = $r->param("delete_sql_host") || ""; 789 my $rename_newCourseID = $r->param("rename_newCourseID") || "";
722 my $delete_sql_port = $r->param("delete_sql_port") || "";
723 my $delete_sql_username = $r->param("delete_sql_username") || "";
724 my $delete_sql_password = $r->param("delete_sql_password") || "";
725 my $delete_sql_database = $r->param("delete_sql_database") || "";
726 790
727 my @courseIDs = listCourses($ce); 791 my @courseIDs = listCourses($ce);
728 @courseIDs = sort @courseIDs; 792 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
729 793
730 my %courseLabels; # records... heh. 794 my %courseLabels; # records... heh.
731 foreach my $courseID (@courseIDs) { 795 foreach my $courseID (@courseIDs) {
732 my $tempCE = WeBWorK::CourseEnvironment->new( 796 my $tempCE = WeBWorK::CourseEnvironment->new(
733 $ce->{webworkDirs}->{root}, 797 $ce->{webworkDirs}->{root},
… …
736 $courseID, 800 $courseID,
737 ); 801 );
738 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 802 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
739 } 803 }
740 804
741 print CGI::h2("Delete Course"); 805 print CGI::h2("Rename Course");
742 806
743 print CGI::start_form("POST", $r->uri); 807 print CGI::start_form(-method=>"POST", -action=>$r->uri);
744 print $self->hidden_authen_fields; 808 print $self->hidden_authen_fields;
745 print $self->hidden_fields("subDisplay"); 809 print $self->hidden_fields("subDisplay");
746 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
840sub 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
879sub 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
933sub 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
747 print CGI::p("Select a course to delete."); 963 print CGI::p("Select a course to delete.");
748 964
749 print CGI::table({class=>"FormLayout"}, 965 print CGI::table({class=>"FormLayout"},
750 CGI::Tr( 966 CGI::Tr({},
751 CGI::th({class=>"LeftHeader"}, "Course Name:"), 967 CGI::th({class=>"LeftHeader"}, "Course Name:"),
752 CGI::td( 968 CGI::td(
753 CGI::scrolling_list( 969 CGI::scrolling_list(
754 -name => "delete_courseID", 970 -name => "delete_courseID",
755 -values => \@courseIDs, 971 -values => \@courseIDs,
… …
760 ), 976 ),
761 ), 977 ),
762 ), 978 ),
763 ); 979 );
764 980
765 print CGI::p(
766 "If the course's database layout (indicated in parentheses above) is "
767 . CGI::b("sql") . ", supply the SQL connections information requested below."
768 );
769
770 print CGI::start_table({class=>"FormLayout"});
771 print CGI::Tr(
772 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
773 CGI::td(
774 CGI::textfield("delete_sql_host", $delete_sql_host, 25),
775 CGI::br(),
776 CGI::small("Leave blank to use the default host."),
777 ),
778 );
779 print CGI::Tr(
780 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
781 CGI::td(
782 CGI::textfield("delete_sql_port", $delete_sql_port, 25),
783 CGI::br(),
784 CGI::small("Leave blank to use the default port."),
785 ),
786 );
787 print CGI::Tr(
788 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
789 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
790 );
791 print CGI::Tr(
792 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
793 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
794 );
795 print CGI::Tr(
796 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
797 CGI::td(
798 CGI::textfield("delete_sql_database", $delete_sql_database, 25),
799 CGI::br(),
800 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
801 ),
802 );
803 print CGI::end_table();
804
805 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course")); 981 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course"));
806 982
807 print CGI::end_form(); 983 print CGI::end_form();
808} 984}
809 985
810sub delete_course_validate { 986sub delete_course_validate {
… …
814 #my $db = $r->db; 990 #my $db = $r->db;
815 #my $authz = $r->authz; 991 #my $authz = $r->authz;
816 my $urlpath = $r->urlpath; 992 my $urlpath = $r->urlpath;
817 993
818 my $delete_courseID = $r->param("delete_courseID") || ""; 994 my $delete_courseID = $r->param("delete_courseID") || "";
819 my $delete_sql_host = $r->param("delete_sql_host") || "";
820 my $delete_sql_port = $r->param("delete_sql_port") || "";
821 my $delete_sql_username = $r->param("delete_sql_username") || "";
822 my $delete_sql_password = $r->param("delete_sql_password") || "";
823 my $delete_sql_database = $r->param("delete_sql_database") || "";
824 995
825 my @errors; 996 my @errors;
826 997
827 if ($delete_courseID eq "") { 998 if ($delete_courseID eq "") {
828 push @errors, "You must specify a course name."; 999 push @errors, "You must specify a course name.";
… …
835 $ce->{webworkURLs}->{root}, 1006 $ce->{webworkURLs}->{root},
836 $ce->{pg}->{directories}->{root}, 1007 $ce->{pg}->{directories}->{root},
837 $delete_courseID, 1008 $delete_courseID,
838 ); 1009 );
839 1010
840 if ($ce2->{dbLayoutName} eq "sql") {
841 push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
842 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
843 #push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
844 }
845
846 return @errors; 1011 return @errors;
847} 1012}
848 1013
849sub delete_course_confirm { 1014sub delete_course_confirm {
850 my ($self) = @_; 1015 my ($self) = @_;
… …
855 #my $urlpath = $r->urlpath; 1020 #my $urlpath = $r->urlpath;
856 1021
857 print CGI::h2("Delete Course"); 1022 print CGI::h2("Delete Course");
858 1023
859 my $delete_courseID = $r->param("delete_courseID") || ""; 1024 my $delete_courseID = $r->param("delete_courseID") || "";
860 my $delete_sql_host = $r->param("delete_sql_host") || "";
861 my $delete_sql_port = $r->param("delete_sql_port") || "";
862 my $delete_sql_database = $r->param("delete_sql_database") || "";
863 1025
864 my $ce2 = WeBWorK::CourseEnvironment->new( 1026 my $ce2 = WeBWorK::CourseEnvironment->new(
865 $ce->{webworkDirs}->{root}, 1027 $ce->{webworkDirs}->{root},
866 $ce->{webworkURLs}->{root}, 1028 $ce->{webworkURLs}->{root},
867 $ce->{pg}->{directories}->{root}, 1029 $ce->{pg}->{directories}->{root},
868 $delete_courseID, 1030 $delete_courseID,
869 ); 1031 );
870 1032
871 if ($ce2->{dbLayoutName} eq "sql") {
872 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID) 1033 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
873 . "? All course files and data and the following database will be destroyed."
874 . " There is no undo available.");
875
876 print CGI::table({class=>"FormLayout"},
877 CGI::Tr(
878 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
879 CGI::td($delete_sql_host || "system default"),
880 ),
881 CGI::Tr(
882 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
883 CGI::td($delete_sql_port || "system default"),
884 ),
885 CGI::Tr(
886 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
887 CGI::td($delete_sql_database || "webwork_$delete_courseID"),
888 ),
889 );
890 } else {
891 print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
892 . "? All course files and data will be destroyed. There is no undo available."); 1034 . "? All course files and data will be destroyed. There is no undo available.");
893 }
894 1035
895 print CGI::start_form("POST", $r->uri); 1036 print CGI::start_form(-method=>"POST", -action=>$r->uri);
896 print $self->hidden_authen_fields; 1037 print $self->hidden_authen_fields;
897 print $self->hidden_fields("subDisplay"); 1038 print $self->hidden_fields("subDisplay");
898 print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/); 1039 print $self->hidden_fields(qw/delete_courseID/);
899 1040
900 print CGI::p({style=>"text-align: center"}, 1041 print CGI::p({style=>"text-align: center"},
901 CGI::submit("decline_delete_course", "Don't delete"), 1042 CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"),
902 "&nbsp;", 1043 "&nbsp;",
903 CGI::submit("confirm_delete_course", "Delete"), 1044 CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"),
904 ); 1045 );
905 1046
906 print CGI::end_form(); 1047 print CGI::end_form();
907} 1048}
908 1049
909sub do_delete_course { 1050sub do_delete_course {
910 my ($self) = @_; 1051 my ($self) = @_;
911 my $r = $self->r; 1052 my $r = $self->r;
912 my $ce = $r->ce; 1053 my $ce = $r->ce;
913 #my $db = $r->db; 1054 my $db = $r->db;
914 #my $authz = $r->authz; 1055 #my $authz = $r->authz;
915 #my $urlpath = $r->urlpath; 1056 #my $urlpath = $r->urlpath;
916 1057
917 my $delete_courseID = $r->param("delete_courseID") || ""; 1058 my $delete_courseID = $r->param("delete_courseID") || "";
918 my $delete_sql_host = $r->param("delete_sql_host") || "";
919 my $delete_sql_port = $r->param("delete_sql_port") || "";
920 my $delete_sql_username = $r->param("delete_sql_username") || "";
921 my $delete_sql_password = $r->param("delete_sql_password") || "";
922 my $delete_sql_database = $r->param("delete_sql_database") || "";
923 1059
924 my $ce2 = WeBWorK::CourseEnvironment->new( 1060 my $ce2 = WeBWorK::CourseEnvironment->new(
925 $ce->{webworkDirs}->{root}, 1061 $ce->{webworkDirs}->{root},
926 $ce->{webworkURLs}->{root}, 1062 $ce->{webworkURLs}->{root},
927 $ce->{pg}->{directories}->{root}, 1063 $ce->{pg}->{directories}->{root},
928 $delete_courseID, 1064 $delete_courseID,
929 ); 1065 );
930 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
931 my %dbOptions; 1070 my %dbOptions;
932 if ($ce2->{dbLayoutName} eq "sql") {
933 $dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
934 $dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
935 $dbOptions{username} = $delete_sql_username;
936 $dbOptions{password} = $delete_sql_password;
937 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID";
938 }
939 1071
940 eval { 1072 eval {
941 deleteCourse( 1073 deleteCourse(
942 courseID => $delete_courseID, 1074 courseID => $delete_courseID,
943 ce => $ce2, 1075 ce => $ce2,
… …
950 print CGI::div({class=>"ResultsWithError"}, 1082 print CGI::div({class=>"ResultsWithError"},
951 CGI::p("An error occured while deleting the course $delete_courseID:"), 1083 CGI::p("An error occured while deleting the course $delete_courseID:"),
952 CGI::tt(CGI::escapeHTML($error)), 1084 CGI::tt(CGI::escapeHTML($error)),
953 ); 1085 );
954 } else { 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
955 print CGI::div({class=>"ResultsWithoutError"}, 1104 print CGI::div({class=>"ResultsWithoutError"},
956 CGI::p("Successfully deleted the course $delete_courseID."), 1105 CGI::p("Successfully deleted the course $delete_courseID."),
957 ); 1106 );
958 writeLog($ce, "hosted_courses", join("\t", 1107 writeLog($ce, "hosted_courses", join("\t",
959 "\tDeleted", 1108 "\tDeleted",
960 "", 1109 "",
961 "", 1110 "",
962 $delete_courseID, 1111 $delete_courseID,
963 )); 1112 ));
964 print CGI::start_form("POST", $r->uri); 1113 print CGI::start_form(-method=>"POST", -action=>$r->uri);
965 print $self->hidden_authen_fields; 1114 print $self->hidden_authen_fields;
966 print $self->hidden_fields("subDisplay"); 1115 print $self->hidden_fields("subDisplay");
967 1116
968 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),); 1117 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),);
969 1118
970 print CGI::end_form(); 1119 print CGI::end_form();
971 } 1120 }
972} 1121}
973 1122
… …
983 1132
984 my @tables = keys %{$ce->{dbLayout}}; 1133 my @tables = keys %{$ce->{dbLayout}};
985 1134
986 my $export_courseID = $r->param("export_courseID") || ""; 1135 my $export_courseID = $r->param("export_courseID") || "";
987 my @export_tables = $r->param("export_tables"); 1136 my @export_tables = $r->param("export_tables");
988 1137
989 @export_tables = @tables unless @export_tables; 1138 @export_tables = @tables unless @export_tables;
990 1139
991 my @courseIDs = listCourses($ce); 1140 my @courseIDs = listCourses($ce);
992 @courseIDs = sort @courseIDs; 1141 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
993 1142
994 my %courseLabels; # records... heh. 1143 my %courseLabels; # records... heh.
995 foreach my $courseID (@courseIDs) { 1144 foreach my $courseID (@courseIDs) {
996 my $tempCE = WeBWorK::CourseEnvironment->new( 1145 my $tempCE = WeBWorK::CourseEnvironment->new(
997 $ce->{webworkDirs}->{root}, 1146 $ce->{webworkDirs}->{root},
… …
1002 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1151 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1003 } 1152 }
1004 1153
1005 print CGI::h2("Export Database"); 1154 print CGI::h2("Export Database");
1006 1155
1156 print CGI::p(IMPORT_EXPORT_WARNING);
1157
1007 print CGI::start_form("GET", $r->uri); 1158 print CGI::start_form(-method=>"GET", -action=>$r->uri);
1008 print $self->hidden_authen_fields; 1159 print $self->hidden_authen_fields;
1009 print $self->hidden_fields("subDisplay"); 1160 print $self->hidden_fields("subDisplay");
1010 1161
1011 print CGI::p("Select a course to export the course's database."); 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.");
1012 1166
1013 print CGI::table({class=>"FormLayout"}, 1167 print CGI::table({class=>"FormLayout"},
1014 CGI::Tr( 1168 CGI::Tr({},
1015 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1169 CGI::th({class=>"LeftHeader"}, "Course Name:"),
1016 CGI::td( 1170 CGI::td(
1017 CGI::scrolling_list( 1171 CGI::scrolling_list(
1018 -name => "export_courseID", 1172 -name => "export_courseID",
1019 -values => \@courseIDs, 1173 -values => \@courseIDs,
1020 -default => $export_courseID, 1174 -default => $export_courseID,
1021 -size => 10, 1175 -size => 10,
1022 -multiple => 0, 1176 -multiple => 1,
1023 -labels => \%courseLabels, 1177 -labels => \%courseLabels,
1024 ), 1178 ),
1025 ), 1179 ),
1026 ), 1180 ),
1027 CGI::Tr( 1181 CGI::Tr({},
1028 CGI::th({class=>"LeftHeader"}, "Tables to Export:"), 1182 CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
1029 CGI::td( 1183 CGI::td({},
1030 CGI::checkbox_group( 1184 CGI::checkbox_group(
1031 -name => "export_tables", 1185 -name => "export_tables",
1032 -values => \@tables, 1186 -values => \@tables,
1033 -default => \@export_tables, 1187 -default => \@export_tables,
1034 -linebreak => 1, 1188 -linebreak => 1,
1035 ), 1189 ),
1036 ), 1190 ),
1037 ), 1191 ),
1038 ); 1192 );
1039 1193
1040 print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database")); 1194 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database"));
1041 1195
1042 print CGI::end_form(); 1196 print CGI::end_form();
1043} 1197}
1044 1198
1045sub export_database_validate { 1199sub export_database_validate {
… …
1048 #my $ce = $r->ce; 1202 #my $ce = $r->ce;
1049 #my $db = $r->db; 1203 #my $db = $r->db;
1050 #my $authz = $r->authz; 1204 #my $authz = $r->authz;
1051 #my $urlpath = $r->urlpath; 1205 #my $urlpath = $r->urlpath;
1052 1206
1053 my $export_courseID = $r->param("export_courseID") || ""; 1207 my @export_courseID = $r->param("export_courseID") || ();
1054 my @export_tables = $r->param("export_tables"); 1208 my @export_tables = $r->param("export_tables");
1055 1209
1056 my @errors; 1210 my @errors;
1057 1211
1058 if ($export_courseID eq "") { 1212 unless ( @export_courseID) {
1059 push @errors, "You must specify a course name."; 1213 push @errors, "You must specify at least one course name.";
1060 } 1214 }
1061 1215
1062 unless (@export_tables) { 1216 unless (@export_tables) {
1063 push @errors, "You must specify at least one table to export."; 1217 push @errors, "You must specify at least one table to export.";
1064 } 1218 }
… …
1072 my $ce = $r->ce; 1226 my $ce = $r->ce;
1073 #my $db = $r->db; 1227 #my $db = $r->db;
1074 #my $authz = $r->authz; 1228 #my $authz = $r->authz;
1075 my $urlpath = $r->urlpath; 1229 my $urlpath = $r->urlpath;
1076 1230
1077 my $export_courseID = $r->param("export_courseID"); 1231 my @export_courseID = $r->param("export_courseID");
1078 my @export_tables = $r->param("export_tables"); 1232 my @export_tables = $r->param("export_tables");
1079 1233
1234 foreach my $export_courseID (@export_courseID) {
1235
1080 my $ce2 = WeBWorK::CourseEnvironment->new( 1236 my $ce2 = WeBWorK::CourseEnvironment->new(
1081 $ce->{webworkDirs}->{root}, 1237 $ce->{webworkDirs}->{root},
1082 $ce->{webworkURLs}->{root}, 1238 $ce->{webworkURLs}->{root},
1083 $ce->{pg}->{directories}->{root}, 1239 $ce->{pg}->{directories}->{root},
1084 $export_courseID, 1240 $export_courseID,
1085 ); 1241 );
1086 1242
1087 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1243 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1088 1244
1089 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1245 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1090 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 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 }
1091 1265
1266 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1267
1092 my @errors; 1268 my @errors;
1093
1094 eval { 1269 eval {
1095 @errors = dbExport( 1270 @errors = dbExport(
1096 db => $db2, 1271 db => $db2,
1097 #xml => $fh, 1272 #xml => $fh,
1098 xml => *STDOUT, 1273 xml => $outputFileHandle,
1099 tables => \@export_tables, 1274 tables => \@export_tables,
1100 ); 1275 );
1101 }; 1276 };
1277
1278 $outputFileHandle->close();
1102 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
1103 #push @errors, "Fatal exception: $@" if $@; 1289 #push @errors, "Fatal exception: $@" if $@;
1104 # 1290 #
1105 #if (@errors) { 1291 #if (@errors) {
1106 # print CGI::div({class=>"ResultsWithError"}, 1292 # print CGI::div({class=>"ResultsWithError"},
1107 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1293 # CGI::p("An error occured while exporting the database of course $export_courseID:"),
… …
1136 my $import_conflict = $r->param("import_conflict") || "skip"; 1322 my $import_conflict = $r->param("import_conflict") || "skip";
1137 1323
1138 @import_tables = @tables unless @import_tables; 1324 @import_tables = @tables unless @import_tables;
1139 1325
1140 my @courseIDs = listCourses($ce); 1326 my @courseIDs = listCourses($ce);
1141 @courseIDs = sort @courseIDs; 1327 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1142 1328
1143 1329
1144 my %courseLabels; # records... heh. 1330 my %courseLabels; # records... heh.
1145 foreach my $courseID (@courseIDs) { 1331 foreach my $courseID (@courseIDs) {
1146 my $tempCE = WeBWorK::CourseEnvironment->new( 1332 my $tempCE = WeBWorK::CourseEnvironment->new(
… …
1150 $courseID, 1336 $courseID,
1151 ); 1337 );
1152 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1338 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1153 } 1339 }
1154 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
1155 print CGI::h2("Import Database"); 1358 print CGI::h2("Import Database");
1156 1359
1360 print CGI::p(IMPORT_EXPORT_WARNING);
1361
1157 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1362 print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART);
1158 print $self->hidden_authen_fields; 1363 print $self->hidden_authen_fields;
1159 print $self->hidden_fields("subDisplay"); 1364 print $self->hidden_fields("subDisplay");
1160 1365
1161 print CGI::table({class=>"FormLayout"}, 1366 print CGI::table({class=>"FormLayout"},
1162 CGI::Tr( 1367 CGI::Tr({},
1163 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1368 CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1164 CGI::td( 1369 CGI::td(
1165 CGI::filefield( 1370 CGI::scrolling_list(
1166 -name => "import_file", 1371 -name => "import_file",
1372 -values => \@databaseFiles,
1373 -default => undef,
1167 -size => 50, 1374 -size => 10,
1375 -multiple => 0,
1376 -labels => \%databaseLabels,
1168 ), 1377 ),
1378
1169 ), 1379 )
1170 ), 1380 ),
1171 CGI::Tr( 1381 CGI::Tr({},
1172 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1382 CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1173 CGI::td( 1383 CGI::td(
1174 CGI::checkbox_group( 1384 CGI::checkbox_group(
1175 -name => "import_tables", 1385 -name => "import_tables",
1176 -values => \@tables, 1386 -values => \@tables,
1177 -default => \@import_tables, 1387 -default => \@import_tables,
1178 -linebreak => 1, 1388 -linebreak => 1,
1179 ), 1389 ),
1180 ), 1390 ),
1181 ), 1391 ),
1182 CGI::Tr( 1392 CGI::Tr({},
1183 CGI::th({class=>"LeftHeader"}, "Import into Course:"), 1393 CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1184 CGI::td( 1394 CGI::td(
1185 CGI::scrolling_list( 1395 CGI::scrolling_list(
1186 -name => "import_courseID", 1396 -name => "import_courseID",
1187 -values => \@courseIDs, 1397 -values => \@courseIDs,
… …
1190 -multiple => 0, 1400 -multiple => 0,
1191 -labels => \%courseLabels, 1401 -labels => \%courseLabels,
1192 ), 1402 ),
1193 ), 1403 ),
1194 ), 1404 ),
1195 CGI::Tr( 1405 CGI::Tr({},
1196 CGI::th({class=>"LeftHeader"}, "Conflicts:"), 1406 CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1197 CGI::td( 1407 CGI::td(
1198 CGI::radio_group( 1408 CGI::radio_group(
1199 -name => "import_conflict", 1409 -name => "import_conflict",
1200 -values => [qw/skip replace/], 1410 -values => [qw/skip replace/],
… …
1207 ), 1417 ),
1208 ), 1418 ),
1209 ), 1419 ),
1210 ); 1420 );
1211 1421
1212 print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database")); 1422 print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database"));
1213 1423
1214 print CGI::end_form(); 1424 print CGI::end_form();
1215} 1425}
1216 1426
1217sub import_database_validate { 1427sub import_database_validate {
… …
1228 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1438 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked
1229 1439
1230 my @errors; 1440 my @errors;
1231 1441
1232 if ($import_file eq "") { 1442 if ($import_file eq "") {
1233 push @errors, "You must specify a database file to upload."; 1443 push @errors, "You must specify a database file to import.";
1234 } 1444 }
1235 1445
1236 if ($import_courseID eq "") { 1446 if ($import_courseID eq "") {
1237 push @errors, "You must specify a course name."; 1447 push @errors, "You must specify a course name.";
1238 } 1448 }
… …
1264 $import_courseID, 1474 $import_courseID,
1265 ); 1475 );
1266 1476
1267 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1477 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1268 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");
1269 # retrieve upload from upload cache 1489 # retrieve upload from upload cache
1270 my ($id, $hash) = split /\s+/, $import_file; 1490# my ($id, $hash) = split /\s+/, $import_file;
1271 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1491# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1272 dir => $ce->{webworkDirs}->{uploadCache} 1492# dir => $ce->{webworkDirs}->{uploadCache}
1273 ); 1493# );
1274 1494
1275 my @errors; 1495 my @errors;
1276 1496
1277 eval { 1497 eval {
1278 @errors = dbImport( 1498 @errors = dbImport(
1279 db => $db2, 1499 db => $db2,
1280 xml => $upload->fileHandle, 1500 # xml => $upload->fileHandle,
1501 xml => $fileHandle,
1281 tables => \@import_tables, 1502 tables => \@import_tables,
1282 conflict => $import_conflict, 1503 conflict => $import_conflict,
1283 ); 1504 );
1284 }; 1505 };
1285 1506
1286 $upload->dispose;
1287
1288 push @errors, "Fatal exception: $@" if $@; 1507 push @errors, "Fatal exception: $@" if $@;
1508 push @errors, $gunzipMessage if $gunzipMessage;
1289 1509
1290 if (@errors) { 1510 if (@errors) {
1291 print CGI::div({class=>"ResultsWithError"}, 1511 print CGI::div({class=>"ResultsWithError"},
1292 CGI::p("An error occured while importing the database of course $import_courseID:"), 1512 CGI::p("An error occured while importing the database of course $import_courseID:"),
1293 CGI::ul(CGI::li(\@errors)), 1513 CGI::ul(CGI::li(\@errors)),
… …
1296 print CGI::div({class=>"ResultsWithoutError"}, 1516 print CGI::div({class=>"ResultsWithoutError"},
1297 CGI::p("Import succeeded."), 1517 CGI::p("Import succeeded."),
1298 ); 1518 );
1299 } 1519 }
1300} 1520}
1521##########################################################################
1522sub 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 );
1301 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
1593sub 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
1621sub 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 "&nbsp;",
1658 CGI::submit(-name=>"confirm_archive_course", -value=>"archive"),
1659 );
1660
1661 print CGI::end_form();
1662}
1663
1664sub 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##########################################################################
1763sub 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
1817sub 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
1844sub 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 "&nbsp;",
1872 CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"),
1873 );
1874
1875 print CGI::end_form();
1876}
1877
1878sub 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################################################################################
13021; 19261;
Legend:
Removed from v.2479  
changed lines
  Added in v.4357
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9