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

Revision 4235 - (view) (download) (as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

1 :	sh002i	1945	################################################################################
2 :			# WeBWorK Online Homework Delivery System
3 :	sh002i	3973	# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4 :	gage	4235	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.48 2006/07/08 14:07:34 gage Exp $
5 :	sh002i	1945	#
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 :	gage	4235	#use CGI qw(-nosticky );
29 :			use WeBWorK::CGI;
30 :	sh002i	1945	use Data::Dumper;
31 :	sh002i	1985	use File::Temp qw/tempfile/;
32 :	sh002i	2138	use WeBWorK::CourseEnvironment;
33 :	gage	3235	use IO::File;
34 :	sh002i	4087	use WeBWorK::Debug;
35 :	gage	3235	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
36 :	gage	4129	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
37 :			listArchivedCourses unarchiveCourse);
38 :	sh002i	1985	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
39 :	sh002i	1945
40 :	sh002i	1985	sub pre_header_initialize {
41 :			my ($self) = @_;
42 :			my $r = $self->r;
43 :			my $ce = $r->ce;
44 :			my $db = $r->db;
45 :			my $authz = $r->authz;
46 :			my $urlpath = $r->urlpath;
47 :	gage	2026	my $user = $r->param('user');
48 :	sh002i	1985
49 :	gage	2026	# check permissions
50 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
51 :			$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
52 :			return;
53 :			}
54 :	sh002i	1945
55 :	gage	3284	# get result and send to message
56 :			my $status_message = $r->param("status_message");
57 :			$self->addmessage(CGI::p("$status_message")) if $status_message;
58 :
59 :	sh002i	2478	## if the user is asking for the downloaded database...
60 :			#if (defined $r->param("download_exported_database")) {
61 :			# my $courseID = $r->param("export_courseID");
62 :			# my $random_chars = $r->param("download_exported_database");
63 :			#
64 :			# die "courseID not specified" unless defined $courseID;
65 :			# die "invalid file specification" unless $random_chars =~ m/^\w+$/;
66 :			#
67 :			# my $tempdir = $ce->{webworkDirs}->{tmp};
68 :			# my $export_file = "$tempdir/db_export_$random_chars";
69 :			#
70 :			# $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0);
71 :			#
72 :			# return "";
73 :			#}
74 :			#
75 :			## otherwise...
76 :	gage	2026
77 :	sh002i	2478	my @errors;
78 :			my $method_to_call;
79 :	gage	2026
80 :	sh002i	1960	my $subDisplay = $r->param("subDisplay");
81 :			if (defined $subDisplay) {
82 :	sh002i	1945
83 :	sh002i	1960	if ($subDisplay eq "add_course") {
84 :			if (defined $r->param("add_course")) {
85 :	sh002i	2478	@errors = $self->add_course_validate;
86 :	sh002i	1960	if (@errors) {
87 :	sh002i	2478	$method_to_call = "add_course_form";
88 :	sh002i	1960	} else {
89 :	sh002i	2478	$method_to_call = "do_add_course";
90 :	sh002i	1960	}
91 :			} else {
92 :	sh002i	2478	$method_to_call = "add_course_form";
93 :	sh002i	1960	}
94 :			}
95 :
96 :	sh002i	3059	elsif ($subDisplay eq "rename_course") {
97 :			if (defined $r->param("rename_course")) {
98 :			@errors = $self->rename_course_validate;
99 :			if (@errors) {
100 :			$method_to_call = "rename_course_form";
101 :			} else {
102 :			$method_to_call = "do_rename_course";
103 :			}
104 :			} else {
105 :			$method_to_call = "rename_course_form";
106 :			}
107 :			}
108 :
109 :	sh002i	1960	elsif ($subDisplay eq "delete_course") {
110 :			if (defined $r->param("delete_course")) {
111 :			# validate or confirm
112 :	sh002i	2478	@errors = $self->delete_course_validate;
113 :	sh002i	1960	if (@errors) {
114 :	sh002i	2478	$method_to_call = "delete_course_form";
115 :	sh002i	1960	} else {
116 :	sh002i	2478	$method_to_call = "delete_course_confirm";
117 :	sh002i	1960	}
118 :			} elsif (defined $r->param("confirm_delete_course")) {
119 :			# validate and delete
120 :	sh002i	2478	@errors = $self->delete_course_validate;
121 :	sh002i	1960	if (@errors) {
122 :	sh002i	2478	$method_to_call = "delete_course_form";
123 :	sh002i	1960	} else {
124 :	sh002i	2478	$method_to_call = "do_delete_course";
125 :	sh002i	1960	}
126 :			} else {
127 :			# form only
128 :	sh002i	2478	$method_to_call = "delete_course_form";
129 :	sh002i	1960	}
130 :			}
131 :
132 :	sh002i	1985	elsif ($subDisplay eq "export_database") {
133 :			if (defined $r->param("export_database")) {
134 :	sh002i	2478	@errors = $self->export_database_validate;
135 :	sh002i	1985	if (@errors) {
136 :	sh002i	2478	$method_to_call = "export_database_form";
137 :	sh002i	1985	} else {
138 :	sh002i	2478	# we have to do something special here, since we're sending
139 :			# the database as we export it. $method_to_call still gets
140 :			# set here, but it gets caught by header() and content()
141 :			# below instead of by body().
142 :			$method_to_call = "do_export_database";
143 :	sh002i	1985	}
144 :			} else {
145 :	sh002i	2478	$method_to_call = "export_database_form";
146 :	sh002i	1985	}
147 :			}
148 :
149 :			elsif ($subDisplay eq "import_database") {
150 :			if (defined $r->param("import_database")) {
151 :	sh002i	2478	@errors = $self->import_database_validate;
152 :	sh002i	1985	if (@errors) {
153 :	sh002i	2478	$method_to_call = "import_database_form";
154 :	sh002i	1985	} else {
155 :	sh002i	2478	$method_to_call = "do_import_database";
156 :	sh002i	1985	}
157 :			} else {
158 :	sh002i	2478	$method_to_call = "import_database_form";
159 :	sh002i	1985	}
160 :			}
161 :
162 :	gage	3528	elsif ($subDisplay eq "archive_course") {
163 :			if (defined $r->param("archive_course")) {
164 :			# validate or confirm
165 :			@errors = $self->archive_course_validate;
166 :			if (@errors) {
167 :			$method_to_call = "archive_course_form";
168 :			} else {
169 :			$method_to_call = "archive_course_confirm";
170 :			}
171 :			} elsif (defined $r->param("confirm_archive_course")) {
172 :			# validate and archive
173 :			@errors = $self->archive_course_validate;
174 :			if (@errors) {
175 :			$method_to_call = "archive_course_form";
176 :			} else {
177 :			$method_to_call = "do_archive_course";
178 :			}
179 :			} else {
180 :			# form only
181 :			$method_to_call = "archive_course_form";
182 :			}
183 :			}
184 :	gage	4129	elsif ($subDisplay eq "unarchive_course") {
185 :			if (defined $r->param("unarchive_course")) {
186 :			# validate or confirm
187 :			@errors = $self->unarchive_course_validate;
188 :			if (@errors) {
189 :			$method_to_call = "unarchive_course_form";
190 :			} else {
191 :			$method_to_call = "unarchive_course_confirm";
192 :			}
193 :			} elsif (defined $r->param("confirm_unarchive_course")) {
194 :			# validate and archive
195 :			@errors = $self->unarchive_course_validate;
196 :			if (@errors) {
197 :			$method_to_call = "unarchive_course_form";
198 :			} else {
199 :			$method_to_call = "do_unarchive_course";
200 :			}
201 :			} else {
202 :			# form only
203 :			$method_to_call = "unarchive_course_form";
204 :			}
205 :			}
206 :	sh002i	1985	else {
207 :	sh002i	2478	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
208 :	sh002i	1985	}
209 :
210 :	sh002i	1960	}
211 :	sh002i	1945
212 :	sh002i	2478	$self->{errors} = \@errors;
213 :			$self->{method_to_call} = $method_to_call;
214 :			}
215 :
216 :			sub header {
217 :			my ($self) = @_;
218 :			my $method_to_call = $self->{method_to_call};
219 :	gage	3235	# if (defined $method_to_call and $method_to_call eq "do_export_database") {
220 :			# my $r = $self->r;
221 :			# my $courseID = $r->param("export_courseID");
222 :			# $r->content_type("application/octet-stream");
223 :			# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
224 :			# $r->send_http_header;
225 :			# } else {
226 :	sh002i	2478	$self->SUPER::header;
227 :	gage	3235	# }
228 :	sh002i	2478	}
229 :
230 :			# sends:
231 :	sh002i	2479	#
232 :	sh002i	2478	# HTTP/1.1 200 OK
233 :			# Date: Fri, 09 Jul 2004 19:05:55 GMT
234 :			# Server: Apache/1.3.27 (Unix) mod_perl/1.27
235 :			# Content-Disposition: attachment; filename="mth143_database.xml"
236 :			# Connection: close
237 :			# Content-Type: application/octet-stream
238 :
239 :			sub content {
240 :			my ($self) = @_;
241 :			my $method_to_call = $self->{method_to_call};
242 :			if (defined $method_to_call and $method_to_call eq "do_export_database") {
243 :	gage	3235	#$self->do_export_database;
244 :			$self->SUPER::content;
245 :	sh002i	2478	} else {
246 :			$self->SUPER::content;
247 :			}
248 :			}
249 :
250 :			sub body {
251 :			my ($self) = @_;
252 :			my $r = $self->r;
253 :			my $ce = $r->ce;
254 :			my $db = $r->db;
255 :			my $authz = $r->authz;
256 :			my $urlpath = $r->urlpath;
257 :
258 :			my $user = $r->param('user');
259 :
260 :			# check permissions
261 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
262 :			return "";
263 :			}
264 :	gage	3235	my $method_to_call = $self->{method_to_call};
265 :			my $methodMessage ="";
266 :	sh002i	2478
267 :	gage	3235	(defined($method_to_call) and $method_to_call eq "do_export_database") && do {
268 :			my @export_courseID = $r->param("export_courseID");
269 :			my $course_ids = join(", ", @export_courseID);
270 :			$methodMessage = CGI::p("Exporting database for course(s) $course_ids").
271 :			CGI::p(".... please wait....
272 :			If your browser times out you will
273 :			still be able to download the exported database using the
274 :			file manager.").CGI::hr();
275 :			};
276 :
277 :
278 :	sh002i	2478	print CGI::p({style=>"text-align: center"},
279 :	gage	3437	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
280 :			add_dbLayout=>'sql_single',
281 :			add_templates_course => $ce->{siteDefaults}->{default_templates_course} \|\|""}
282 :			)},
283 :			"Add Course"
284 :			),
285 :	sh002i	2478	" \| ",
286 :	sh002i	3059	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
287 :			" \| ",
288 :	sh002i	2478	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
289 :			" \| ",
290 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
291 :			" \| ",
292 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
293 :	gage	3528	" \| ",
294 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
295 :	gage	4129	"\|",
296 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"),
297 :	gage	3235	CGI::hr(),
298 :			$methodMessage,
299 :
300 :	sh002i	2478	);
301 :
302 :	gage	3235	print CGI::p("The ability to import and to export databases is still under development.
303 :			It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
304 :			use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
305 :			Please send bug reports if you find errors. ");
306 :	sh002i	2478
307 :			my @errors = @{$self->{errors}};
308 :
309 :	gage	3235
310 :	sh002i	2478	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 :	gage	3434	} else {
320 :
321 :			print CGI::h2("Courses");
322 :
323 :	gage	3435	print CGI::start_ol();
324 :	gage	3434
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 :	gage	3435	print CGI::end_ol();
346 :	gage	4129
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 :	sh002i	2478	}
357 :	sh002i	1960	return "";
358 :			}
359 :
360 :	sh002i	1985	################################################################################
361 :
362 :	sh002i	1960	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 :	sh002i	1945
370 :	gage	2254	my $add_courseID = $r->param("add_courseID") \|\| "";
371 :	sh002i	2378	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 :	gage	2254	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
386 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
387 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
388 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
389 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
390 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
391 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
392 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
393 :	sh002i	1945
394 :	sh002i	2639	my @dbLayouts = do {
395 :			my @ordered_layouts;
396 :	sh002i	4087	foreach my $layout (@{$ce->{dbLayout_order}}) {
397 :	sh002i	2639	if (exists $ce->{dbLayouts}->{$layout}) {
398 :			push @ordered_layouts, $layout;
399 :			}
400 :			}
401 :
402 :			my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
403 :			my @other_layouts;
404 :			foreach my $layout (keys %{ $ce->{dbLayouts} }) {
405 :			unless (exists $ordered_layouts{$layout}) {
406 :			push @other_layouts, $layout;
407 :			}
408 :			}
409 :
410 :			(@ordered_layouts, @other_layouts);
411 :			};
412 :	sh002i	1960
413 :			my $ce2 = WeBWorK::CourseEnvironment->new(
414 :			$ce->{webworkDirs}->{root},
415 :			$ce->{webworkURLs}->{root},
416 :			$ce->{pg}->{directories}->{root},
417 :			"COURSENAME",
418 :			);
419 :
420 :	sh002i	2378	my @existingCourses = listCourses($ce);
421 :	gage	3434	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
422 :	sh002i	2148
423 :	sh002i	1960	print CGI::h2("Add Course");
424 :	sh002i	1945
425 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
426 :			print $self->hidden_authen_fields;
427 :			print $self->hidden_fields("subDisplay");
428 :	sh002i	1945
429 :	sh002i	2378	print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores.");
430 :	sh002i	1960
431 :			print CGI::table({class=>"FormLayout"},
432 :			CGI::Tr(
433 :	gage	2242	CGI::th({class=>"LeftHeader"}, "Course ID:"),
434 :	sh002i	1960	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
435 :			),
436 :	gage	2242	CGI::Tr(
437 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Course Title:"),
438 :			CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)),
439 :	gage	2242	),
440 :			CGI::Tr(
441 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Institution:"),
442 :			CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
443 :	gage	2242	),
444 :	sh002i	2378	);
445 :
446 :			print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
447 :	gage	3437	my $checked = ($add_admin_users) ?"checked": ""; # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
448 :			print CGI::p(CGI::input({-type=>'checkbox', -name=>"add_admin_users", $checked=>'' }, "Add WeBWorK administrators to new course"));
449 :	sh002i	2378
450 :	gage	4127	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only
451 :			numbers, letters, hyphens, periods (dots), commas,and underscores.\n");
452 :	sh002i	2378
453 :			print CGI::table({class=>"FormLayout"}, CGI::Tr(
454 :			CGI::td(
455 :			CGI::table({class=>"FormLayout"},
456 :			CGI::Tr(
457 :			CGI::th({class=>"LeftHeader"}, "User ID:"),
458 :			CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)),
459 :			),
460 :			CGI::Tr(
461 :			CGI::th({class=>"LeftHeader"}, "Password:"),
462 :			CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
463 :			),
464 :			CGI::Tr(
465 :			CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
466 :			CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)),
467 :			),
468 :			),
469 :	gage	2299	),
470 :	sh002i	2378	CGI::td(
471 :			CGI::table({class=>"FormLayout"},
472 :			CGI::Tr(
473 :			CGI::th({class=>"LeftHeader"}, "First Name:"),
474 :			CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)),
475 :			),
476 :			CGI::Tr(
477 :			CGI::th({class=>"LeftHeader"}, "Last Name:"),
478 :			CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)),
479 :			),
480 :			CGI::Tr(
481 :			CGI::th({class=>"LeftHeader"}, "Email Address:"),
482 :			CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)),
483 :			),
484 :			),
485 :	gage	2242
486 :			),
487 :	sh002i	2378	));
488 :	gage	2254
489 :	sh002i	2378	print CGI::p("To copy problem templates from an existing course, select the course below.");
490 :	gage	2254
491 :			print CGI::table({class=>"FormLayout"},
492 :			CGI::Tr(
493 :			CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
494 :			CGI::td(
495 :			CGI::popup_menu(
496 :			-name => "add_templates_course",
497 :			-values => [ "", @existingCourses ],
498 :			-default => $add_templates_course,
499 :			#-size => 10,
500 :			#-multiple => 0,
501 :			#-labels => \%courseLabels,
502 :			),
503 :
504 :			),
505 :			),
506 :			);
507 :
508 :	sh002i	2378	print CGI::p("Select a database layout below.");
509 :	sh002i	1960
510 :			foreach my $dbLayout (@dbLayouts) {
511 :			print CGI::start_table({class=>"FormLayout"});
512 :
513 :	sh002i	4087	my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
514 :			? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
515 :	sh002i	2639	: $dbLayout;
516 :
517 :	sh002i	1960	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
518 :			print CGI::Tr(
519 :			CGI::td({style=>"text-align: right"},
520 :			'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
521 :			. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
522 :	sh002i	1945	),
523 :	sh002i	2639	CGI::td($dbLayoutLabel),
524 :	sh002i	1945	);
525 :
526 :			print CGI::end_table();
527 :			}
528 :
529 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
530 :
531 :			print CGI::end_form();
532 :			}
533 :
534 :			sub add_course_validate {
535 :			my ($self) = @_;
536 :			my $r = $self->r;
537 :			my $ce = $r->ce;
538 :			#my $db = $r->db;
539 :			#my $authz = $r->authz;
540 :			#my $urlpath = $r->urlpath;
541 :
542 :	gage	2254	my $add_courseID = $r->param("add_courseID") \|\| "";
543 :	sh002i	2378	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
544 :			my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
545 :
546 :			my $add_admin_users = $r->param("add_admin_users") \|\| "";
547 :
548 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
549 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
550 :			my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
551 :			my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
552 :			my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
553 :			my $add_initial_email = $r->param("add_initial_email") \|\| "";
554 :
555 :			my $add_templates_course = $r->param("add_templates_course") \|\| "";
556 :
557 :	gage	2254	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
558 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
559 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
560 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
561 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
562 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
563 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
564 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
565 :	sh002i	2378
566 :	sh002i	1960	my @errors;
567 :
568 :			if ($add_courseID eq "") {
569 :	sh002i	2378	push @errors, "You must specify a course ID.";
570 :	sh002i	1960	}
571 :	sh002i	2887	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
572 :			push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
573 :			}
574 :	sh002i	2373	if (grep { $add_courseID eq $_ } listCourses($ce)) {
575 :	sh002i	2378	push @errors, "A course with ID $add_courseID already exists.";
576 :	sh002i	2373	}
577 :	sh002i	2378	if ($add_courseTitle eq "") {
578 :			push @errors, "You must specify a course title.";
579 :	gage	2242	}
580 :	sh002i	2378	if ($add_courseInstitution eq "") {
581 :			push @errors, "You must specify an institution for this course.";
582 :	gage	2242	}
583 :	sh002i	2378
584 :			if ($add_initial_userID ne "") {
585 :			if ($add_initial_password eq "") {
586 :			push @errors, "You must specify a password for the initial instructor.";
587 :			}
588 :			if ($add_initial_confirmPassword eq "") {
589 :			push @errors, "You must confirm the password for the initial instructor.";
590 :			}
591 :			if ($add_initial_password ne $add_initial_confirmPassword) {
592 :			push @errors, "The password and password confirmation for the instructor must match.";
593 :			}
594 :			if ($add_initial_firstName eq "") {
595 :			push @errors, "You must specify a first name for the initial instructor.";
596 :			}
597 :			if ($add_initial_lastName eq "") {
598 :			push @errors, "You must specify a last name for the initial instructor.";
599 :			}
600 :			if ($add_initial_email eq "") {
601 :			push @errors, "You must specify an email address for the initial instructor.";
602 :			}
603 :	gage	2242	}
604 :	sh002i	1960
605 :			if ($add_dbLayout eq "") {
606 :			push @errors, "You must select a database layout.";
607 :			} else {
608 :			if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
609 :			if ($add_dbLayout eq "sql") {
610 :			push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
611 :			push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
612 :			} elsif ($add_dbLayout eq "gdbm") {
613 :			push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
614 :			}
615 :			} else {
616 :			push @errors, "The database layout $add_dbLayout doesn't exist.";
617 :			}
618 :			}
619 :
620 :			return @errors;
621 :			}
622 :
623 :			sub do_add_course {
624 :			my ($self) = @_;
625 :			my $r = $self->r;
626 :			my $ce = $r->ce;
627 :			my $db = $r->db;
628 :	gage	4127	my $authz = $r->authz;
629 :	sh002i	1960	my $urlpath = $r->urlpath;
630 :
631 :	sh002i	2378	my $add_courseID = $r->param("add_courseID") \|\| "";
632 :			my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
633 :			my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
634 :
635 :			my $add_admin_users = $r->param("add_admin_users") \|\| "";
636 :
637 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
638 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
639 :			my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
640 :			my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
641 :			my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
642 :			my $add_initial_email = $r->param("add_initial_email") \|\| "";
643 :
644 :			my $add_templates_course = $r->param("add_templates_course") \|\| "";
645 :
646 :			my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
647 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
648 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
649 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
650 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
651 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
652 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
653 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
654 :	gage	2242
655 :	sh002i	1960	my $ce2 = WeBWorK::CourseEnvironment->new(
656 :			$ce->{webworkDirs}->{root},
657 :			$ce->{webworkURLs}->{root},
658 :			$ce->{pg}->{directories}->{root},
659 :			$add_courseID,
660 :			);
661 :
662 :	gage	2042	my %courseOptions = ( dbLayoutName => $add_dbLayout );
663 :	sh002i	2384
664 :			if ($add_initial_email ne "") {
665 :			$courseOptions{allowedRecipients} = [ $add_initial_email ];
666 :	sh002i	2853	# don't set feedbackRecipients -- this just gets in the way of the more
667 :			# intelligent "receive_recipients" method.
668 :			#$courseOptions{feedbackRecipients} = [ $add_initial_email ];
669 :	sh002i	2384	}
670 :
671 :	sh002i	2004	if ($add_dbLayout eq "gdbm") {
672 :			$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
673 :			}
674 :
675 :	sh002i	1960	my %dbOptions;
676 :			if ($add_dbLayout eq "sql") {
677 :			$dbOptions{host} = $add_sql_host if $add_sql_host ne "";
678 :			$dbOptions{port} = $add_sql_port if $add_sql_port ne "";
679 :			$dbOptions{username} = $add_sql_username;
680 :			$dbOptions{password} = $add_sql_password;
681 :	sh002i	2104	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";
682 :	sh002i	1960	$dbOptions{wwhost} = $add_sql_wwhost;
683 :			}
684 :	sh002i	2378
685 :	sh002i	1960	my @users;
686 :	sh002i	2378
687 :			# copy users from current (admin) course if desired
688 :			if ($add_admin_users ne "") {
689 :			foreach my $userID ($db->listUsers) {
690 :	sh002i	2887	if ($userID eq $add_initial_userID) {
691 :	gage	3284	$self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
692 :	sh002i	2885	next;
693 :			}
694 :	sh002i	2378	my $User = $db->getUser($userID);
695 :			my $Password = $db->getPassword($userID);
696 :			my $PermissionLevel = $db->getPermissionLevel($userID);
697 :	gage	4127	push @users, [ $User, $Password, $PermissionLevel ]
698 :			if $authz->hasPermissions($userID,"create_and_delete_courses");
699 :			#only transfer the "instructors" in the admin course classlist.
700 :	sh002i	2378	}
701 :			}
702 :
703 :			# add initial instructor if desired
704 :	sh002i	1960	if ($add_initial_userID ne "") {
705 :	sh002i	2004	my $User = $db->newUser(
706 :	sh002i	2384	user_id => $add_initial_userID,
707 :			first_name => $add_initial_firstName,
708 :			last_name => $add_initial_lastName,
709 :			student_id => $add_initial_userID,
710 :			email_address => $add_initial_email,
711 :			status => "C",
712 :	sh002i	2004	);
713 :			my $Password = $db->newPassword(
714 :	sh002i	2378	user_id => $add_initial_userID,
715 :	sh002i	1960	password => cryptPassword($add_initial_password),
716 :	sh002i	2004	);
717 :			my $PermissionLevel = $db->newPermissionLevel(
718 :	sh002i	2378	user_id => $add_initial_userID,
719 :	sh002i	1960	permission => "10",
720 :	sh002i	2004	);
721 :			push @users, [ $User, $Password, $PermissionLevel ];
722 :	sh002i	1960	}
723 :	sh002i	2378
724 :	dpvc	2704	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
725 :	sh002i	2384
726 :	sh002i	2148	my %optional_arguments;
727 :			if ($add_templates_course ne "") {
728 :			$optional_arguments{templatesFrom} = $add_templates_course;
729 :			}
730 :
731 :	sh002i	1960	eval {
732 :			addCourse(
733 :	sh002i	2004	courseID => $add_courseID,
734 :			ce => $ce2,
735 :			courseOptions => \%courseOptions,
736 :			dbOptions => \%dbOptions,
737 :			users => \@users,
738 :	sh002i	2148	%optional_arguments,
739 :	sh002i	1945	);
740 :	sh002i	1960	};
741 :			if ($@) {
742 :			my $error = $@;
743 :			print CGI::div({class=>"ResultsWithError"},
744 :			CGI::p("An error occured while creating the course $add_courseID:"),
745 :			CGI::tt(CGI::escapeHTML($error)),
746 :			);
747 :	gage	2254	# get rid of any partially built courses
748 :			# FIXME -- this is too fragile
749 :			unless ($error =~ /course exists/) {
750 :			eval {
751 :			deleteCourse(
752 :			courseID => $add_courseID,
753 :			ce => $ce2,
754 :			dbOptions => \%dbOptions,
755 :			);
756 :			}
757 :			}
758 :	sh002i	1960	} else {
759 :	gage	2256	#log the action
760 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
761 :			"\tAdded",
762 :	sh002i	2378	$add_courseInstitution,
763 :			$add_courseTitle,
764 :	gage	2242	$add_courseID,
765 :	sh002i	2378	$add_initial_firstName,
766 :			$add_initial_lastName,
767 :			$add_initial_email,
768 :	gage	2242	));
769 :	gage	2256	# add contact to admin course as student?
770 :			# FIXME -- should we do this?
771 :	gage	4127	if ($add_initial_userID ne "") {
772 :			my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact
773 :			my $User = $db->newUser(
774 :			user_id => $composite_id, # student id includes school name and contact
775 :			first_name => $add_initial_firstName,
776 :			last_name => $add_initial_lastName,
777 :			student_id => $add_initial_userID,
778 :			email_address => $add_initial_email,
779 :			status => "C",
780 :			);
781 :			my $Password = $db->newPassword(
782 :			user_id => $composite_id,
783 :			password => cryptPassword($add_initial_password),
784 :			);
785 :			my $PermissionLevel = $db->newPermissionLevel(
786 :			user_id => $composite_id,
787 :			permission => "0",
788 :			);
789 :			# add contact to admin course as student
790 :			# or if this contact and course already exist in a dropped status
791 :			# change the student's status to enrolled
792 :			if (my $oldUser = $db->getUser($composite_id) ) {
793 :			warn "Replacing old data for $composite_id status: ". $oldUser->status;
794 :			$db->deleteUser($composite_id);
795 :			}
796 :			eval { $db->addUser($User) }; warn $@ if $@;
797 :			eval { $db->addPassword($Password) }; warn $@ if $@;
798 :			eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@;
799 :			}
800 :	sh002i	1960	print CGI::div({class=>"ResultsWithoutError"},
801 :			CGI::p("Successfully created the course $add_courseID"),
802 :			);
803 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
804 :			courseID => $add_courseID);
805 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
806 :			print CGI::div({style=>"text-align: center"},
807 :			CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
808 :			);
809 :			}
810 :	gage	2322
811 :	gage	2299
812 :	sh002i	1960	}
813 :
814 :			################################################################################
815 :
816 :	sh002i	3059	sub rename_course_form {
817 :			my ($self) = @_;
818 :			my $r = $self->r;
819 :			my $ce = $r->ce;
820 :			#my $db = $r->db;
821 :			#my $authz = $r->authz;
822 :			#my $urlpath = $r->urlpath;
823 :
824 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
825 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
826 :
827 :			my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
828 :			my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
829 :			my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
830 :			my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
831 :			my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
832 :			my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
833 :			my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
834 :
835 :			my @courseIDs = listCourses($ce);
836 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
837 :	sh002i	3059
838 :			my %courseLabels; # records... heh.
839 :			foreach my $courseID (@courseIDs) {
840 :			my $tempCE = WeBWorK::CourseEnvironment->new(
841 :			$ce->{webworkDirs}->{root},
842 :			$ce->{webworkURLs}->{root},
843 :			$ce->{pg}->{directories}->{root},
844 :			$courseID,
845 :			);
846 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
847 :			}
848 :
849 :			print CGI::h2("Rename Course");
850 :
851 :			print CGI::start_form("POST", $r->uri);
852 :			print $self->hidden_authen_fields;
853 :			print $self->hidden_fields("subDisplay");
854 :
855 :			print CGI::p("Select a course to rename.");
856 :
857 :			print CGI::table({class=>"FormLayout"},
858 :			CGI::Tr(
859 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
860 :			CGI::td(
861 :			CGI::scrolling_list(
862 :			-name => "rename_oldCourseID",
863 :			-values => \@courseIDs,
864 :			-default => $rename_oldCourseID,
865 :			-size => 10,
866 :			-multiple => 0,
867 :			-labels => \%courseLabels,
868 :			),
869 :			),
870 :			),
871 :			CGI::Tr(
872 :			CGI::th({class=>"LeftHeader"}, "New Name:"),
873 :			CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
874 :			),
875 :			);
876 :
877 :			print CGI::p(
878 :			"If the course's database layout (indicated in parentheses above) is "
879 :			. CGI::b("sql") . ", supply the SQL connections information requested below."
880 :			);
881 :
882 :			print CGI::start_table({class=>"FormLayout"});
883 :			print CGI::Tr(CGI::td({colspan=>2},
884 :			"Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
885 :			)
886 :			);
887 :			print CGI::Tr(
888 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
889 :			CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
890 :			);
891 :			print CGI::Tr(
892 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
893 :			CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
894 :			);
895 :
896 :			print CGI::Tr(
897 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
898 :			CGI::td(
899 :			CGI::textfield("rename_sql_host", $rename_sql_host, 25),
900 :			CGI::br(),
901 :			CGI::small("Leave blank to use the default host."),
902 :			),
903 :			);
904 :			print CGI::Tr(
905 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
906 :			CGI::td(
907 :			CGI::textfield("rename_sql_port", $rename_sql_port, 25),
908 :			CGI::br(),
909 :			CGI::small("Leave blank to use the default port."),
910 :			),
911 :			);
912 :
913 :			print CGI::Tr(
914 :			CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
915 :			CGI::td(
916 :			CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
917 :			CGI::br(),
918 :			CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
919 :			),
920 :			);
921 :			print CGI::Tr(
922 :			CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
923 :			CGI::td(
924 :			CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
925 :			CGI::br(),
926 :			CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
927 :			),
928 :			);
929 :			print CGI::Tr(
930 :			CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
931 :			CGI::td(
932 :			CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost \|\| "localhost", 25),
933 :			CGI::br(),
934 :			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."),
935 :			),
936 :			);
937 :			print CGI::end_table();
938 :
939 :			print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
940 :
941 :			print CGI::end_form();
942 :			}
943 :
944 :			sub rename_course_validate {
945 :			my ($self) = @_;
946 :			my $r = $self->r;
947 :			my $ce = $r->ce;
948 :			#my $db = $r->db;
949 :			#my $authz = $r->authz;
950 :			#my $urlpath = $r->urlpath;
951 :
952 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
953 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
954 :
955 :			my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
956 :			my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
957 :			my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
958 :			my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
959 :			my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
960 :			my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
961 :			my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
962 :
963 :			my @errors;
964 :
965 :			if ($rename_oldCourseID eq "") {
966 :			push @errors, "You must select a course to rename.";
967 :			}
968 :			if ($rename_newCourseID eq "") {
969 :			push @errors, "You must specify a new name for the course.";
970 :			}
971 :			if ($rename_oldCourseID eq $rename_newCourseID) {
972 :			push @errors, "Can't rename to the same name.";
973 :			}
974 :			unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
975 :			push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
976 :			}
977 :			if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
978 :			push @errors, "A course with ID $rename_newCourseID already exists.";
979 :			}
980 :
981 :			my $ce2 = WeBWorK::CourseEnvironment->new(
982 :			$ce->{webworkDirs}->{root},
983 :			$ce->{webworkURLs}->{root},
984 :			$ce->{pg}->{directories}->{root},
985 :			$rename_oldCourseID,
986 :			);
987 :
988 :			if ($ce2->{dbLayoutName} eq "sql") {
989 :			push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
990 :			#push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
991 :			#push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
992 :			#push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
993 :			}
994 :
995 :			return @errors;
996 :			}
997 :
998 :			sub do_rename_course {
999 :			my ($self) = @_;
1000 :			my $r = $self->r;
1001 :			my $ce = $r->ce;
1002 :			my $db = $r->db;
1003 :			#my $authz = $r->authz;
1004 :			my $urlpath = $r->urlpath;
1005 :
1006 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
1007 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
1008 :
1009 :			my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
1010 :			my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
1011 :			my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
1012 :			my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
1013 :			my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
1014 :			my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
1015 :			my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
1016 :
1017 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1018 :			$ce->{webworkDirs}->{root},
1019 :			$ce->{webworkURLs}->{root},
1020 :			$ce->{pg}->{directories}->{root},
1021 :			$rename_oldCourseID,
1022 :			);
1023 :
1024 :			my $dbLayoutName = $ce->{dbLayoutName};
1025 :
1026 :			my %dbOptions;
1027 :			if ($dbLayoutName eq "sql") {
1028 :			$dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
1029 :			$dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
1030 :			$dbOptions{username} = $rename_sql_username;
1031 :			$dbOptions{password} = $rename_sql_password;
1032 :			$dbOptions{old_database} = $rename_sql_oldDatabase \|\| "webwork_$rename_oldCourseID";
1033 :			$dbOptions{new_database} = $rename_sql_newDatabase \|\| "webwork_$rename_newCourseID";
1034 :			$dbOptions{wwhost} = $rename_sql_wwhost;
1035 :			}
1036 :
1037 :			eval {
1038 :			renameCourse(
1039 :			courseID => $rename_oldCourseID,
1040 :			ce => $ce2,
1041 :			dbOptions => \%dbOptions,
1042 :			newCourseID => $rename_newCourseID,
1043 :			);
1044 :			};
1045 :			if ($@) {
1046 :			my $error = $@;
1047 :			print CGI::div({class=>"ResultsWithError"},
1048 :			CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
1049 :			CGI::tt(CGI::escapeHTML($error)),
1050 :			);
1051 :			} else {
1052 :			print CGI::div({class=>"ResultsWithoutError"},
1053 :			CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
1054 :			);
1055 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
1056 :			courseID => $rename_newCourseID);
1057 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
1058 :			print CGI::div({style=>"text-align: center"},
1059 :			CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
1060 :			);
1061 :			}
1062 :			}
1063 :
1064 :			################################################################################
1065 :
1066 :	sh002i	1960	sub delete_course_form {
1067 :			my ($self) = @_;
1068 :			my $r = $self->r;
1069 :			my $ce = $r->ce;
1070 :			#my $db = $r->db;
1071 :			#my $authz = $r->authz;
1072 :			#my $urlpath = $r->urlpath;
1073 :
1074 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1075 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
1076 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
1077 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
1078 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
1079 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
1080 :
1081 :			my @courseIDs = listCourses($ce);
1082 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1083 :	sh002i	1960
1084 :			my %courseLabels; # records... heh.
1085 :			foreach my $courseID (@courseIDs) {
1086 :			my $tempCE = WeBWorK::CourseEnvironment->new(
1087 :			$ce->{webworkDirs}->{root},
1088 :			$ce->{webworkURLs}->{root},
1089 :			$ce->{pg}->{directories}->{root},
1090 :			$courseID,
1091 :			);
1092 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1093 :			}
1094 :
1095 :			print CGI::h2("Delete Course");
1096 :
1097 :			print CGI::start_form("POST", $r->uri);
1098 :			print $self->hidden_authen_fields;
1099 :			print $self->hidden_fields("subDisplay");
1100 :
1101 :			print CGI::p("Select a course to delete.");
1102 :
1103 :			print CGI::table({class=>"FormLayout"},
1104 :			CGI::Tr(
1105 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
1106 :	sh002i	1945	CGI::td(
1107 :	sh002i	1960	CGI::scrolling_list(
1108 :			-name => "delete_courseID",
1109 :			-values => \@courseIDs,
1110 :			-default => $delete_courseID,
1111 :			-size => 10,
1112 :			-multiple => 0,
1113 :			-labels => \%courseLabels,
1114 :	sh002i	1945	),
1115 :			),
1116 :	sh002i	1960	),
1117 :			);
1118 :
1119 :			print CGI::p(
1120 :			"If the course's database layout (indicated in parentheses above) is "
1121 :			. CGI::b("sql") . ", supply the SQL connections information requested below."
1122 :			);
1123 :
1124 :	sh002i	2719	print CGI::start_table({class=>"FormLayout"});
1125 :			print CGI::Tr(CGI::td({colspan=>2},
1126 :			"Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database."
1127 :			)
1128 :			);
1129 :			print CGI::Tr(
1130 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
1131 :			CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
1132 :			);
1133 :			print CGI::Tr(
1134 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
1135 :			CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
1136 :			);
1137 :	sh002i	1960
1138 :	sh002i	2719	#print CGI::Tr(CGI::td({colspan=>2},
1139 :			# "The optionial SQL settings you enter below must match the settings in the DBI source"
1140 :			# . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
1141 :			# . " with the course name you entered above."
1142 :			# )
1143 :			#);
1144 :			print CGI::Tr(
1145 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
1146 :			CGI::td(
1147 :			CGI::textfield("delete_sql_host", $delete_sql_host, 25),
1148 :			CGI::br(),
1149 :			CGI::small("Leave blank to use the default host."),
1150 :			),
1151 :			);
1152 :			print CGI::Tr(
1153 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
1154 :			CGI::td(
1155 :			CGI::textfield("delete_sql_port", $delete_sql_port, 25),
1156 :			CGI::br(),
1157 :			CGI::small("Leave blank to use the default port."),
1158 :			),
1159 :			);
1160 :
1161 :			print CGI::Tr(
1162 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
1163 :			CGI::td(
1164 :			CGI::textfield("delete_sql_database", $delete_sql_database, 25),
1165 :			CGI::br(),
1166 :			CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
1167 :			),
1168 :			);
1169 :			print CGI::end_table();
1170 :
1171 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
1172 :
1173 :			print CGI::end_form();
1174 :			}
1175 :
1176 :			sub delete_course_validate {
1177 :			my ($self) = @_;
1178 :			my $r = $self->r;
1179 :			my $ce = $r->ce;
1180 :			#my $db = $r->db;
1181 :			#my $authz = $r->authz;
1182 :			my $urlpath = $r->urlpath;
1183 :
1184 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1185 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
1186 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
1187 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
1188 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
1189 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
1190 :
1191 :			my @errors;
1192 :
1193 :			if ($delete_courseID eq "") {
1194 :			push @errors, "You must specify a course name.";
1195 :			} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
1196 :			push @errors, "You cannot delete the course you are currently using.";
1197 :			}
1198 :
1199 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1200 :			$ce->{webworkDirs}->{root},
1201 :			$ce->{webworkURLs}->{root},
1202 :			$ce->{pg}->{directories}->{root},
1203 :			$delete_courseID,
1204 :			);
1205 :
1206 :			if ($ce2->{dbLayoutName} eq "sql") {
1207 :			push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
1208 :	sh002i	2189	#push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
1209 :			#push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
1210 :	sh002i	1960	}
1211 :
1212 :			return @errors;
1213 :			}
1214 :
1215 :			sub delete_course_confirm {
1216 :			my ($self) = @_;
1217 :			my $r = $self->r;
1218 :			my $ce = $r->ce;
1219 :			#my $db = $r->db;
1220 :			#my $authz = $r->authz;
1221 :			#my $urlpath = $r->urlpath;
1222 :
1223 :			print CGI::h2("Delete Course");
1224 :
1225 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1226 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
1227 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
1228 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
1229 :
1230 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1231 :			$ce->{webworkDirs}->{root},
1232 :			$ce->{webworkURLs}->{root},
1233 :			$ce->{pg}->{directories}->{root},
1234 :			$delete_courseID,
1235 :			);
1236 :
1237 :			if ($ce2->{dbLayoutName} eq "sql") {
1238 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
1239 :			. "? All course files and data and the following database will be destroyed."
1240 :			. " There is no undo available.");
1241 :
1242 :			print CGI::table({class=>"FormLayout"},
1243 :			CGI::Tr(
1244 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
1245 :			CGI::td($delete_sql_host \|\| "system default"),
1246 :	sh002i	1945	),
1247 :	sh002i	1960	CGI::Tr(
1248 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
1249 :			CGI::td($delete_sql_port \|\| "system default"),
1250 :			),
1251 :			CGI::Tr(
1252 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
1253 :	sh002i	2189	CGI::td($delete_sql_database \|\| "webwork_$delete_courseID"),
1254 :	sh002i	1960	),
1255 :	sh002i	1945	);
1256 :	sh002i	1960	} else {
1257 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
1258 :			. "? All course files and data will be destroyed. There is no undo available.");
1259 :	sh002i	1945	}
1260 :
1261 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
1262 :			print $self->hidden_authen_fields;
1263 :			print $self->hidden_fields("subDisplay");
1264 :			print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
1265 :
1266 :			print CGI::p({style=>"text-align: center"},
1267 :			CGI::submit("decline_delete_course", "Don't delete"),
1268 :			" ",
1269 :			CGI::submit("confirm_delete_course", "Delete"),
1270 :			);
1271 :
1272 :			print CGI::end_form();
1273 :			}
1274 :
1275 :			sub do_delete_course {
1276 :			my ($self) = @_;
1277 :			my $r = $self->r;
1278 :			my $ce = $r->ce;
1279 :	gage	4127	my $db = $r->db;
1280 :	sh002i	1960	#my $authz = $r->authz;
1281 :			#my $urlpath = $r->urlpath;
1282 :
1283 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1284 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
1285 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
1286 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
1287 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
1288 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
1289 :
1290 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1291 :			$ce->{webworkDirs}->{root},
1292 :			$ce->{webworkURLs}->{root},
1293 :			$ce->{pg}->{directories}->{root},
1294 :			$delete_courseID,
1295 :			);
1296 :
1297 :			my %dbOptions;
1298 :			if ($ce2->{dbLayoutName} eq "sql") {
1299 :			$dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
1300 :			$dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
1301 :			$dbOptions{username} = $delete_sql_username;
1302 :			$dbOptions{password} = $delete_sql_password;
1303 :	sh002i	2189	$dbOptions{database} = $delete_sql_database \|\| "webwork_$delete_courseID";
1304 :	sh002i	1960	}
1305 :
1306 :			eval {
1307 :			deleteCourse(
1308 :			courseID => $delete_courseID,
1309 :			ce => $ce2,
1310 :			dbOptions => \%dbOptions,
1311 :			);
1312 :			};
1313 :
1314 :			if ($@) {
1315 :			my $error = $@;
1316 :			print CGI::div({class=>"ResultsWithError"},
1317 :			CGI::p("An error occured while deleting the course $delete_courseID:"),
1318 :			CGI::tt(CGI::escapeHTML($error)),
1319 :			);
1320 :			} else {
1321 :	gage	4127	# mark the contact person in the admin course as dropped.
1322 :			# find the contact person for the course by searching the admin classlist.
1323 :			my @contacts = grep /_$delete_courseID$/, $db->listUsers;
1324 :			die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1;
1325 :			#warn "contacts", join(" ", @contacts);
1326 :			#my $composite_id = "${add_initial_userID}_${add_courseID}";
1327 :			my $composite_id = $contacts[0];
1328 :
1329 :			# mark the contact person as dropped.
1330 :			my $User = $db->getUser($composite_id);
1331 :			my $status_name = 'Drop';
1332 :			my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
1333 :			$User->status($status_value);
1334 :			$db->putUser($User);
1335 :
1336 :	sh002i	1960	print CGI::div({class=>"ResultsWithoutError"},
1337 :	sh002i	2378	CGI::p("Successfully deleted the course $delete_courseID."),
1338 :	sh002i	1960	);
1339 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
1340 :			"\tDeleted",
1341 :			"",
1342 :			"",
1343 :			$delete_courseID,
1344 :			));
1345 :	sh002i	1945	print CGI::start_form("POST", $r->uri);
1346 :			print $self->hidden_authen_fields;
1347 :	sh002i	1960	print $self->hidden_fields("subDisplay");
1348 :	sh002i	1945
1349 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
1350 :	sh002i	1945
1351 :	sh002i	1960	print CGI::end_form();
1352 :	sh002i	1945	}
1353 :			}
1354 :
1355 :	sh002i	1985	################################################################################
1356 :
1357 :			sub export_database_form {
1358 :			my ($self) = @_;
1359 :			my $r = $self->r;
1360 :			my $ce = $r->ce;
1361 :			#my $db = $r->db;
1362 :			#my $authz = $r->authz;
1363 :			#my $urlpath = $r->urlpath;
1364 :
1365 :			my @tables = keys %{$ce->{dbLayout}};
1366 :
1367 :			my $export_courseID = $r->param("export_courseID") \|\| "";
1368 :			my @export_tables = $r->param("export_tables");
1369 :	gage	3235
1370 :	sh002i	1985	@export_tables = @tables unless @export_tables;
1371 :
1372 :			my @courseIDs = listCourses($ce);
1373 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1374 :	sh002i	1985
1375 :			my %courseLabels; # records... heh.
1376 :			foreach my $courseID (@courseIDs) {
1377 :			my $tempCE = WeBWorK::CourseEnvironment->new(
1378 :			$ce->{webworkDirs}->{root},
1379 :			$ce->{webworkURLs}->{root},
1380 :			$ce->{pg}->{directories}->{root},
1381 :			$courseID,
1382 :			);
1383 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1384 :			}
1385 :
1386 :			print CGI::h2("Export Database");
1387 :
1388 :	sh002i	2478	print CGI::start_form("GET", $r->uri);
1389 :	sh002i	1985	print $self->hidden_authen_fields;
1390 :			print $self->hidden_fields("subDisplay");
1391 :
1392 :	sh002i	2844	print CGI::p("Select a course to export the course's database. Please note
1393 :			that exporting can take a very long time for a large course. If you have
1394 :			shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
1395 :			utility instead.");
1396 :	sh002i	1985
1397 :			print CGI::table({class=>"FormLayout"},
1398 :			CGI::Tr(
1399 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
1400 :			CGI::td(
1401 :			CGI::scrolling_list(
1402 :			-name => "export_courseID",
1403 :			-values => \@courseIDs,
1404 :			-default => $export_courseID,
1405 :			-size => 10,
1406 :	gage	3235	-multiple => 1,
1407 :	sh002i	1985	-labels => \%courseLabels,
1408 :			),
1409 :			),
1410 :			),
1411 :			CGI::Tr(
1412 :			CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
1413 :			CGI::td(
1414 :			CGI::checkbox_group(
1415 :			-name => "export_tables",
1416 :			-values => \@tables,
1417 :			-default => \@export_tables,
1418 :			-linebreak => 1,
1419 :			),
1420 :			),
1421 :			),
1422 :			);
1423 :
1424 :			print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
1425 :
1426 :			print CGI::end_form();
1427 :			}
1428 :
1429 :			sub export_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 :	gage	3235	my @export_courseID = $r->param("export_courseID") \|\| ();
1438 :	sh002i	1985	my @export_tables = $r->param("export_tables");
1439 :	gage	3235
1440 :	sh002i	1985	my @errors;
1441 :	gage	3235
1442 :			unless ( @export_courseID) {
1443 :			push @errors, "You must specify at least one course name.";
1444 :	sh002i	1985	}
1445 :
1446 :			unless (@export_tables) {
1447 :			push @errors, "You must specify at least one table to export.";
1448 :			}
1449 :
1450 :			return @errors;
1451 :			}
1452 :
1453 :			sub do_export_database {
1454 :			my ($self) = @_;
1455 :			my $r = $self->r;
1456 :			my $ce = $r->ce;
1457 :			#my $db = $r->db;
1458 :			#my $authz = $r->authz;
1459 :			my $urlpath = $r->urlpath;
1460 :
1461 :	gage	3235	my @export_courseID = $r->param("export_courseID");
1462 :	sh002i	1985	my @export_tables = $r->param("export_tables");
1463 :
1464 :	gage	3235	foreach my $export_courseID (@export_courseID) {
1465 :
1466 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1467 :			$ce->{webworkDirs}->{root},
1468 :			$ce->{webworkURLs}->{root},
1469 :			$ce->{pg}->{directories}->{root},
1470 :			$export_courseID,
1471 :			);
1472 :
1473 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1474 :
1475 :			#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1476 :			#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1477 :			# export to the admin/templates directory
1478 :			my $exportFileName = "$export_courseID.exported.xml";
1479 :			my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
1480 :			# get a unique name
1481 :			my $number =1;
1482 :			while (-e "$exportFilePath.$number.gz") {
1483 :			$number++;
1484 :			last if $number>9;
1485 :			}
1486 :			if ($number<=9 ) {
1487 :			$exportFilePath = "$exportFilePath.$number";
1488 :			$exportFileName = "$exportFileName.$number";
1489 :			} else {
1490 :			$self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
1491 :			remove some of these files."));
1492 :			$exportFilePath = "$exportFilePath.999";
1493 :			$exportFileName = "$exportFileName.999";
1494 :			}
1495 :	sh002i	1985
1496 :	gage	3235	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1497 :	sh002i	1985
1498 :	gage	3235	my @errors;
1499 :			eval {
1500 :			@errors = dbExport(
1501 :			db => $db2,
1502 :			#xml => $fh,
1503 :			xml => $outputFileHandle,
1504 :			tables => \@export_tables,
1505 :			);
1506 :			};
1507 :
1508 :			$outputFileHandle->close();
1509 :	sh002i	1985
1510 :	gage	3235	my $gzipMessage = system( 'gzip', $exportFilePath);
1511 :			if ( !$gzipMessage ) {
1512 :			$self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
1513 :			You may download it with the file manager."));
1514 :			} else {
1515 :			$self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
1516 :			}
1517 :			unlink $exportFilePath;
1518 :			} # end export of one course
1519 :	sh002i	2478	#push @errors, "Fatal exception: $@" if $@;
1520 :			#
1521 :			#if (@errors) {
1522 :			# print CGI::div({class=>"ResultsWithError"},
1523 :			# CGI::p("An error occured while exporting the database of course $export_courseID:"),
1524 :			# CGI::ul(CGI::li(\@errors)),
1525 :			# );
1526 :			#} else {
1527 :			# print CGI::div({class=>"ResultsWithoutError"},
1528 :			# CGI::p("Export succeeded."),
1529 :			# );
1530 :			#
1531 :			# print CGI::div({style=>"text-align: center"},
1532 :			# CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1533 :			# );
1534 :			#}
1535 :	sh002i	1985	}
1536 :
1537 :			################################################################################
1538 :
1539 :			sub import_database_form {
1540 :			my ($self) = @_;
1541 :			my $r = $self->r;
1542 :			my $ce = $r->ce;
1543 :			#my $db = $r->db;
1544 :			#my $authz = $r->authz;
1545 :			#my $urlpath = $r->urlpath;
1546 :
1547 :			my @tables = keys %{$ce->{dbLayout}};
1548 :
1549 :			my $import_file = $r->param("import_file") \|\| "";
1550 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1551 :			my @import_tables = $r->param("import_tables");
1552 :			my $import_conflict = $r->param("import_conflict") \|\| "skip";
1553 :
1554 :			@import_tables = @tables unless @import_tables;
1555 :
1556 :			my @courseIDs = listCourses($ce);
1557 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1558 :	gage	2045
1559 :	sh002i	1985
1560 :			my %courseLabels; # records... heh.
1561 :			foreach my $courseID (@courseIDs) {
1562 :			my $tempCE = WeBWorK::CourseEnvironment->new(
1563 :			$ce->{webworkDirs}->{root},
1564 :			$ce->{webworkURLs}->{root},
1565 :			$ce->{pg}->{directories}->{root},
1566 :			$courseID,
1567 :			);
1568 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1569 :			}
1570 :
1571 :	gage	3235	# find databases:
1572 :			my $templatesDir = $ce->{courseDirs}->{templates};
1573 :			my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
1574 :			my $exempt_dirs = join("\|", keys %probLibs);
1575 :
1576 :			my @databaseFiles = listFilesRecursive(
1577 :			$templatesDir,
1578 :			qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
1579 :			qr/^(?:$exempt_dirs\|CVS)$/, # prune these directories
1580 :			0, # match against file name only
1581 :			1, # prune against path relative to $templatesDir
1582 :			);
1583 :
1584 :			my %databaseLabels = map { ($_ => $_) } @databaseFiles;
1585 :
1586 :			#######
1587 :
1588 :	sh002i	1985	print CGI::h2("Import Database");
1589 :
1590 :			print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1591 :			print $self->hidden_authen_fields;
1592 :			print $self->hidden_fields("subDisplay");
1593 :
1594 :			print CGI::table({class=>"FormLayout"},
1595 :			CGI::Tr(
1596 :			CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1597 :	gage	3235	# CGI::td(
1598 :			# CGI::filefield(
1599 :			# -name => "import_file",
1600 :			# -size => 50,
1601 :			# ),
1602 :			# ),
1603 :	sh002i	1985	CGI::td(
1604 :	gage	3235	CGI::scrolling_list(
1605 :	sh002i	1985	-name => "import_file",
1606 :	gage	3235	-values => \@databaseFiles,
1607 :			-default => undef,
1608 :			-size => 10,
1609 :			-multiple => 0,
1610 :			-labels => \%databaseLabels,
1611 :	sh002i	1985	),
1612 :	gage	3235
1613 :			)
1614 :	sh002i	1985	),
1615 :			CGI::Tr(
1616 :			CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1617 :			CGI::td(
1618 :			CGI::checkbox_group(
1619 :			-name => "import_tables",
1620 :			-values => \@tables,
1621 :			-default => \@import_tables,
1622 :			-linebreak => 1,
1623 :			),
1624 :			),
1625 :			),
1626 :			CGI::Tr(
1627 :			CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1628 :			CGI::td(
1629 :			CGI::scrolling_list(
1630 :			-name => "import_courseID",
1631 :			-values => \@courseIDs,
1632 :			-default => $import_courseID,
1633 :			-size => 10,
1634 :			-multiple => 0,
1635 :			-labels => \%courseLabels,
1636 :			),
1637 :			),
1638 :			),
1639 :			CGI::Tr(
1640 :			CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1641 :			CGI::td(
1642 :			CGI::radio_group(
1643 :			-name => "import_conflict",
1644 :			-values => [qw/skip replace/],
1645 :			-default => $import_conflict,
1646 :			-linebreak=>'true',
1647 :			-labels => {
1648 :			skip => "Skip duplicate records",
1649 :			replace => "Replace duplicate records",
1650 :			},
1651 :			),
1652 :			),
1653 :			),
1654 :			);
1655 :
1656 :			print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1657 :
1658 :			print CGI::end_form();
1659 :			}
1660 :
1661 :			sub import_database_validate {
1662 :			my ($self) = @_;
1663 :			my $r = $self->r;
1664 :			#my $ce = $r->ce;
1665 :			#my $db = $r->db;
1666 :			#my $authz = $r->authz;
1667 :			#my $urlpath = $r->urlpath;
1668 :
1669 :			my $import_file = $r->param("import_file") \|\| "";
1670 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1671 :			my @import_tables = $r->param("import_tables");
1672 :			#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1673 :
1674 :			my @errors;
1675 :
1676 :			if ($import_file eq "") {
1677 :	gage	3235	push @errors, "You must specify a database file to import.";
1678 :	sh002i	1985	}
1679 :
1680 :			if ($import_courseID eq "") {
1681 :			push @errors, "You must specify a course name.";
1682 :			}
1683 :
1684 :			unless (@import_tables) {
1685 :			push @errors, "You must specify at least one table to import.";
1686 :			}
1687 :
1688 :			return @errors;
1689 :			}
1690 :
1691 :			sub do_import_database {
1692 :			my ($self) = @_;
1693 :			my $r = $self->r;
1694 :			my $ce = $r->ce;
1695 :			#my $db = $r->db;
1696 :			#my $authz = $r->authz;
1697 :			my $urlpath = $r->urlpath;
1698 :
1699 :			my $import_file = $r->param("import_file");
1700 :			my $import_courseID = $r->param("import_courseID");
1701 :			my @import_tables = $r->param("import_tables");
1702 :			my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
1703 :
1704 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1705 :			$ce->{webworkDirs}->{root},
1706 :			$ce->{webworkURLs}->{root},
1707 :			$ce->{pg}->{directories}->{root},
1708 :			$import_courseID,
1709 :			);
1710 :
1711 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1712 :
1713 :	gage	3235	# locate file
1714 :			my $templateDir = $ce->{courseDirs}->{templates};
1715 :			my $filePath = "$templateDir/$import_file";
1716 :
1717 :			my $gunzipMessage = system( 'gunzip', $filePath);
1718 :			#FIXME
1719 :			#warn "gunzip ", $gunzipMessage;
1720 :			$filePath =~ s/\.gz$//;
1721 :			#warn "new file path is $filePath";
1722 :			my $fileHandle = new IO::File("<$filePath");
1723 :	sh002i	1985	# retrieve upload from upload cache
1724 :	gage	3235	# my ($id, $hash) = split /\s+/, $import_file;
1725 :			# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1726 :			# dir => $ce->{webworkDirs}->{uploadCache}
1727 :			# );
1728 :	sh002i	1985
1729 :			my @errors;
1730 :
1731 :			eval {
1732 :			@errors = dbImport(
1733 :			db => $db2,
1734 :	gage	3235	# xml => $upload->fileHandle,
1735 :			xml => $fileHandle,
1736 :	sh002i	1985	tables => \@import_tables,
1737 :			conflict => $import_conflict,
1738 :			);
1739 :			};
1740 :
1741 :			push @errors, "Fatal exception: $@" if $@;
1742 :	gage	3235	push @errors, $gunzipMessage if $gunzipMessage;
1743 :	sh002i	1985
1744 :			if (@errors) {
1745 :			print CGI::div({class=>"ResultsWithError"},
1746 :			CGI::p("An error occured while importing the database of course $import_courseID:"),
1747 :			CGI::ul(CGI::li(\@errors)),
1748 :			);
1749 :			} else {
1750 :			print CGI::div({class=>"ResultsWithoutError"},
1751 :			CGI::p("Import succeeded."),
1752 :			);
1753 :			}
1754 :			}
1755 :	gage	3528	##########################################################################
1756 :			sub archive_course_form {
1757 :			my ($self) = @_;
1758 :			my $r = $self->r;
1759 :			my $ce = $r->ce;
1760 :			#my $db = $r->db;
1761 :			#my $authz = $r->authz;
1762 :			#my $urlpath = $r->urlpath;
1763 :
1764 :			my $archive_courseID = $r->param("archive_courseID") \|\| "";
1765 :			my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
1766 :			my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
1767 :			my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
1768 :			my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
1769 :			my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
1770 :
1771 :			my @courseIDs = listCourses($ce);
1772 :			@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1773 :
1774 :			my %courseLabels; # records... heh.
1775 :			foreach my $courseID (@courseIDs) {
1776 :			my $tempCE = WeBWorK::CourseEnvironment->new(
1777 :			$ce->{webworkDirs}->{root},
1778 :			$ce->{webworkURLs}->{root},
1779 :			$ce->{pg}->{directories}->{root},
1780 :			$courseID,
1781 :			);
1782 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1783 :			}
1784 :
1785 :			print CGI::h2("archive Course");
1786 :
1787 :			print CGI::start_form("POST", $r->uri);
1788 :			print $self->hidden_authen_fields;
1789 :			print $self->hidden_fields("subDisplay");
1790 :
1791 :			print CGI::p("Select a course to archive.");
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 => "archive_courseID",
1799 :			-values => \@courseIDs,
1800 :			-default => $archive_courseID,
1801 :			-size => 10,
1802 :			-multiple => 0,
1803 :			-labels => \%courseLabels,
1804 :			),
1805 :			),
1806 :	gage	4136
1807 :	gage	3528	),
1808 :	gage	4136	CGI::Tr(
1809 :			CGI::th({class=>"LeftHeader"}, "Delete course:"),
1810 :			CGI::td({-style=>'color:red'}, CGI::checkbox({
1811 :			-name=>'delete_course',
1812 :			-checked=>0,
1813 :			-value => 1,
1814 :			-label =>'Delete course after archiving. Caution there is no undo!',
1815 :			},
1816 :			),
1817 :			),
1818 :			)
1819 :	gage	3528	);
1820 :
1821 :			print CGI::p(
1822 :			"Currently the archive facility is only available for mysql databases.
1823 :			It depends on the mysqldump application."
1824 :			);
1825 :	gage	4129
1826 :	gage	3528
1827 :			print CGI::p({style=>"text-align: center"}, CGI::submit("archive_course", "archive Course"));
1828 :
1829 :			print CGI::end_form();
1830 :			}
1831 :	sh002i	1985
1832 :	gage	3528	sub archive_course_validate {
1833 :			my ($self) = @_;
1834 :			my $r = $self->r;
1835 :			my $ce = $r->ce;
1836 :			#my $db = $r->db;
1837 :			#my $authz = $r->authz;
1838 :			my $urlpath = $r->urlpath;
1839 :
1840 :			my $archive_courseID = $r->param("archive_courseID") \|\| "";
1841 :			my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
1842 :			my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
1843 :			my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
1844 :			my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
1845 :			my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
1846 :
1847 :			my @errors;
1848 :
1849 :			if ($archive_courseID eq "") {
1850 :			push @errors, "You must specify a course name.";
1851 :			} elsif ($archive_courseID eq $urlpath->arg("courseID")) {
1852 :			push @errors, "You cannot archive the course you are currently using.";
1853 :			}
1854 :
1855 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1856 :			$ce->{webworkDirs}->{root},
1857 :			$ce->{webworkURLs}->{root},
1858 :			$ce->{pg}->{directories}->{root},
1859 :			$archive_courseID,
1860 :			);
1861 :
1862 :			if ($ce2->{dbLayoutName} eq "sql") {
1863 :			push @errors, "You must specify the SQL admin username." if $archive_sql_username eq "";
1864 :			#push @errors, "You must specify the SQL admin password." if $archive_sql_password eq "";
1865 :			#push @errors, "You must specify the SQL database name." if $archive_sql_database eq "";
1866 :			}
1867 :
1868 :			return @errors;
1869 :			}
1870 :
1871 :			sub archive_course_confirm {
1872 :			my ($self) = @_;
1873 :			my $r = $self->r;
1874 :			my $ce = $r->ce;
1875 :			#my $db = $r->db;
1876 :			#my $authz = $r->authz;
1877 :			#my $urlpath = $r->urlpath;
1878 :
1879 :			print CGI::h2("archive Course");
1880 :
1881 :			my $archive_courseID = $r->param("archive_courseID") \|\| "";
1882 :			my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
1883 :			my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
1884 :			my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
1885 :	gage	4136	my $delete_course_flag = $r->param("delete_course") \|\| "";
1886 :	gage	3528	my $ce2 = WeBWorK::CourseEnvironment->new(
1887 :			$ce->{webworkDirs}->{root},
1888 :			$ce->{webworkURLs}->{root},
1889 :			$ce->{pg}->{directories}->{root},
1890 :			$archive_courseID,
1891 :			);
1892 :
1893 :	gage	4136	if ($ce2->{dbLayoutName} ) {
1894 :	gage	3528	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
1895 :	gage	3621	. "? ");
1896 :	gage	4136	print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ".
1897 :			CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag;
1898 :	gage	3528
1899 :	gage	4136
1900 :	gage	3528	}
1901 :
1902 :			print CGI::start_form("POST", $r->uri);
1903 :			print $self->hidden_authen_fields;
1904 :			print $self->hidden_fields("subDisplay");
1905 :	gage	4136	print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database delete_course/);
1906 :	gage	3528
1907 :			print CGI::p({style=>"text-align: center"},
1908 :			CGI::submit("decline_archive_course", "Don't archive"),
1909 :			" ",
1910 :			CGI::submit("confirm_archive_course", "archive"),
1911 :			);
1912 :
1913 :			print CGI::end_form();
1914 :			}
1915 :
1916 :			sub do_archive_course {
1917 :			my ($self) = @_;
1918 :			my $r = $self->r;
1919 :			my $ce = $r->ce;
1920 :	gage	4136	my $db = $r->db;
1921 :	gage	3528	#my $authz = $r->authz;
1922 :			#my $urlpath = $r->urlpath;
1923 :
1924 :			my $archive_courseID = $r->param("archive_courseID") \|\| "";
1925 :			my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
1926 :			my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
1927 :			my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
1928 :			my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
1929 :			my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
1930 :	gage	4136	my $delete_course_flag = $r->param("delete_course") \|\| "";
1931 :	gage	3528
1932 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1933 :			$ce->{webworkDirs}->{root},
1934 :			$ce->{webworkURLs}->{root},
1935 :			$ce->{pg}->{directories}->{root},
1936 :			$archive_courseID,
1937 :			);
1938 :
1939 :			my %dbOptions;
1940 :			if ($ce2->{dbLayoutName} eq "sql") {
1941 :			$dbOptions{host} = $archive_sql_host if $archive_sql_host ne "";
1942 :			$dbOptions{port} = $archive_sql_port if $archive_sql_port ne "";
1943 :			$dbOptions{username} = $archive_sql_username;
1944 :			$dbOptions{password} = $archive_sql_password;
1945 :			$dbOptions{database} = $archive_sql_database \|\| "webwork_$archive_courseID";
1946 :			}
1947 :
1948 :			eval {
1949 :			archiveCourse(
1950 :			courseID => $archive_courseID,
1951 :			ce => $ce2,
1952 :			dbOptions => \%dbOptions,
1953 :			);
1954 :			};
1955 :
1956 :			if ($@) {
1957 :			my $error = $@;
1958 :			print CGI::div({class=>"ResultsWithError"},
1959 :			CGI::p("An error occured while archiving the course $archive_courseID:"),
1960 :			CGI::tt(CGI::escapeHTML($error)),
1961 :			);
1962 :			} else {
1963 :			print CGI::div({class=>"ResultsWithoutError"},
1964 :			CGI::p("Successfully archived the course $archive_courseID"),
1965 :			);
1966 :			writeLog($ce, "hosted_courses", join("\t",
1967 :			"\tarchived",
1968 :			"",
1969 :			"",
1970 :			$archive_courseID,
1971 :			));
1972 :	gage	4136
1973 :			if ($delete_course_flag) {
1974 :			eval {
1975 :			deleteCourse(
1976 :			courseID => $archive_courseID,
1977 :			ce => $ce2,
1978 :			dbOptions => \%dbOptions,
1979 :			);
1980 :			};
1981 :
1982 :			if ($@) {
1983 :			my $error = $@;
1984 :			print CGI::div({class=>"ResultsWithError"},
1985 :			CGI::p("An error occured while deleting the course $archive_courseID:"),
1986 :			CGI::tt(CGI::escapeHTML($error)),
1987 :			);
1988 :			} else {
1989 :			# mark the contact person in the admin course as dropped.
1990 :			# find the contact person for the course by searching the admin classlist.
1991 :			my @contacts = grep /_$archive_courseID$/, $db->listUsers;
1992 :			die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1;
1993 :			#warn "contacts", join(" ", @contacts);
1994 :			#my $composite_id = "${add_initial_userID}_${add_courseID}";
1995 :			my $composite_id = $contacts[0];
1996 :
1997 :			# mark the contact person as dropped.
1998 :			my $User = $db->getUser($composite_id);
1999 :			my $status_name = 'Drop';
2000 :			my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
2001 :			$User->status($status_value);
2002 :			$db->putUser($User);
2003 :
2004 :			print CGI::div({class=>"ResultsWithoutError"},
2005 :			CGI::p("Successfully deleted the course $archive_courseID."),
2006 :			);
2007 :			}
2008 :
2009 :
2010 :			}
2011 :
2012 :	gage	4129	# print CGI::start_form("POST", $r->uri);
2013 :			# print $self->hidden_authen_fields;
2014 :			# print $self->hidden_fields("subDisplay");
2015 :			#
2016 :			# print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),);
2017 :			#
2018 :			# print CGI::end_form();
2019 :	gage	3528	}
2020 :			}
2021 :	gage	4129	##########################################################################
2022 :			sub unarchive_course_form {
2023 :			my ($self) = @_;
2024 :			my $r = $self->r;
2025 :			my $ce = $r->ce;
2026 :			#my $db = $r->db;
2027 :			#my $authz = $r->authz;
2028 :			#my $urlpath = $r->urlpath;
2029 :
2030 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2031 :			my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
2032 :			my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
2033 :			my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
2034 :			my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
2035 :			my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
2036 :
2037 :			# First find courses which have been archived.
2038 :			my @courseIDs = listArchivedCourses($ce);
2039 :			@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
2040 :
2041 :			my %courseLabels; # records... heh.
2042 :			foreach my $courseID (@courseIDs) {
2043 :			$courseLabels{$courseID} = $courseID;
2044 :			}
2045 :
2046 :			print CGI::h2("Unarchive Course -- not yet operational");
2047 :
2048 :			print CGI::start_form("POST", $r->uri);
2049 :			print $self->hidden_authen_fields;
2050 :			print $self->hidden_fields("subDisplay");
2051 :
2052 :			print CGI::p("Select a course to unarchive.");
2053 :
2054 :			print CGI::table({class=>"FormLayout"},
2055 :			CGI::Tr(
2056 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
2057 :			CGI::td(
2058 :			CGI::scrolling_list(
2059 :			-name => "unarchive_courseID",
2060 :			-values => \@courseIDs,
2061 :			-default => $unarchive_courseID,
2062 :			-size => 10,
2063 :			-multiple => 0,
2064 :			-labels => \%courseLabels,
2065 :			),
2066 :			),
2067 :			),
2068 :			);
2069 :
2070 :			print CGI::p(
2071 :			"Currently the unarchive facility is only available for mysql databases.
2072 :			It depends on the mysqldump application."
2073 :			);
2074 :	gage	3528
2075 :	gage	4129
2076 :			print CGI::p({style=>"text-align: center"}, CGI::submit("unarchive_course", "Unarchive Course"));
2077 :
2078 :			print CGI::end_form();
2079 :			}
2080 :
2081 :			sub unarchive_course_validate {
2082 :			my ($self) = @_;
2083 :			my $r = $self->r;
2084 :			my $ce = $r->ce;
2085 :			#my $db = $r->db;
2086 :			#my $authz = $r->authz;
2087 :			my $urlpath = $r->urlpath;
2088 :
2089 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2090 :			my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
2091 :			my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
2092 :			my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
2093 :			my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
2094 :			my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
2095 :
2096 :			my @errors;
2097 :
2098 :			my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
2099 :
2100 :			if ($new_courseID eq "") {
2101 :			push @errors, "You must specify a course name.";
2102 :			} elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) {
2103 :			#Check that a directory for this course doesn't already exist
2104 :			push @errors, "A directory already exists with the name $new_courseID.
2105 :			You must first delete this existing course before you can unarchive.";
2106 :			}
2107 :
2108 :
2109 :
2110 :			return @errors;
2111 :			}
2112 :
2113 :			sub unarchive_course_confirm {
2114 :			my ($self) = @_;
2115 :			my $r = $self->r;
2116 :			my $ce = $r->ce;
2117 :			#my $db = $r->db;
2118 :			#my $authz = $r->authz;
2119 :			#my $urlpath = $r->urlpath;
2120 :
2121 :			print CGI::h2("Unarchive Course");
2122 :
2123 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2124 :			my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
2125 :			my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
2126 :			my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
2127 :
2128 :			my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
2129 :
2130 :
2131 :
2132 :			print CGI::start_form("POST", $r->uri);
2133 :			print CGI::p($unarchive_courseID," to course ",
2134 :			CGI::input({-name=>'new_courseID', -value=>$new_courseID})
2135 :			);
2136 :
2137 :			print $self->hidden_authen_fields;
2138 :			print $self->hidden_fields("subDisplay");
2139 :			print $self->hidden_fields(qw/unarchive_courseID
2140 :			unarchive_sql_host
2141 :			unarchive_sql_port
2142 :			unarchive_sql_username
2143 :			unarchive_sql_password
2144 :			unarchive_sql_database/);
2145 :
2146 :			print CGI::p({style=>"text-align: center"},
2147 :			CGI::submit("decline_unarchive_course", "Don't unarchive"),
2148 :			" ",
2149 :			CGI::submit("confirm_unarchive_course", "unarchive"),
2150 :			);
2151 :
2152 :			print CGI::end_form();
2153 :			}
2154 :
2155 :			sub do_unarchive_course {
2156 :			my ($self) = @_;
2157 :			my $r = $self->r;
2158 :			my $ce = $r->ce;
2159 :			#my $db = $r->db;
2160 :			#my $authz = $r->authz;
2161 :			my $urlpath = $r->urlpath;
2162 :			my $new_courseID = $r->param("new_courseID") \|\| "";
2163 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2164 :			my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
2165 :			my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
2166 :			my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
2167 :			my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
2168 :			my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
2169 :
2170 :
2171 :			my %dbOptions;
2172 :
2173 :			eval {
2174 :			unarchiveCourse(
2175 :			courseID => $new_courseID,
2176 :			archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID",
2177 :			ce => $ce , # $ce2,
2178 :			dbOptions => undef,
2179 :			);
2180 :			};
2181 :
2182 :			if ($@) {
2183 :			my $error = $@;
2184 :			print CGI::div({class=>"ResultsWithError"},
2185 :			CGI::p("An error occured while archiving the course $unarchive_courseID:"),
2186 :			CGI::tt(CGI::escapeHTML($error)),
2187 :			);
2188 :			} else {
2189 :			print CGI::div({class=>"ResultsWithoutError"},
2190 :			CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"),
2191 :			);
2192 :			writeLog($ce, "hosted_courses", join("\t",
2193 :			"\tunarchived",
2194 :			"",
2195 :			"",
2196 :			"$unarchive_courseID to $new_courseID",
2197 :			));
2198 :
2199 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
2200 :			courseID => $new_courseID);
2201 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
2202 :			print CGI::div({style=>"text-align: center"},
2203 :			CGI::a({href=>$newCourseURL}, "Log into $new_courseID"),
2204 :			);
2205 :			# print CGI::start_form("POST", $r->uri);
2206 :			# print $self->hidden_authen_fields;
2207 :			# print $self->hidden_fields("subDisplay");
2208 :			#
2209 :			# print CGI::p({style=>"text-align: center"}, CGI::submit("decline_unarchive_course", "OK"),);
2210 :			#
2211 :			# print CGI::end_form();
2212 :			}
2213 :			}
2214 :
2215 :	gage	3528	################################################################################
2216 :	sh002i	1945	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9