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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9