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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9