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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9