Annotation of /trunk/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

Revision 6176 - (view) (download) (as text)

1 :	sh002i	1945	################################################################################
2 :			# WeBWorK Online Homework Delivery System
3 :	sh002i	5319	# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4 :	gage	6175	# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.86 2009/07/07 18:19:43 apizer 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 :	glarose	4910	use Data::Dumper;
31 :	sh002i	1985	use File::Temp qw/tempfile/;
32 :	sh002i	2138	use WeBWorK::CourseEnvironment;
33 :	gage	3235	use IO::File;
34 :	gage	5664	use URI::Escape;
35 :	sh002i	4087	use WeBWorK::Debug;
36 :	gage	5679	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive trim_spaces);
37 :	gage	4129	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
38 :	gage	5978	listArchivedCourses unarchiveCourse);
39 :			use WeBWorK::Utils::CourseIntegrityCheck;
40 :	sh002i	1985	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
41 :	glarose	4910	# needed for location management
42 :			use Net::IP;
43 :	sh002i	1945
44 :	sh002i	4312	use constant IMPORT_EXPORT_WARNING => "The ability to import and export
45 :			databases is still under development. It seems to work but it is <b>VERY</b>
46 :			slow on large courses. You may prefer to use webwork2/bin/wwdb or the mysql
47 :			dump facility for archiving large courses. Please send bug reports if you find
48 :			errors.";
49 :
50 :	sh002i	1985	sub pre_header_initialize {
51 :			my ($self) = @_;
52 :			my $r = $self->r;
53 :			my $ce = $r->ce;
54 :			my $db = $r->db;
55 :			my $authz = $r->authz;
56 :			my $urlpath = $r->urlpath;
57 :	gage	2026	my $user = $r->param('user');
58 :	sh002i	1985
59 :	gage	2026	# check permissions
60 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
61 :			$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
62 :			return;
63 :			}
64 :	sh002i	1945
65 :	gage	3284	# get result and send to message
66 :			my $status_message = $r->param("status_message");
67 :			$self->addmessage(CGI::p("$status_message")) if $status_message;
68 :
69 :	sh002i	2478	## if the user is asking for the downloaded database...
70 :			#if (defined $r->param("download_exported_database")) {
71 :			# my $courseID = $r->param("export_courseID");
72 :			# my $random_chars = $r->param("download_exported_database");
73 :			#
74 :			# die "courseID not specified" unless defined $courseID;
75 :			# die "invalid file specification" unless $random_chars =~ m/^\w+$/;
76 :			#
77 :			# my $tempdir = $ce->{webworkDirs}->{tmp};
78 :			# my $export_file = "$tempdir/db_export_$random_chars";
79 :			#
80 :			# $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0);
81 :			#
82 :			# return "";
83 :			#}
84 :			#
85 :			## otherwise...
86 :	gage	2026
87 :	sh002i	2478	my @errors;
88 :			my $method_to_call;
89 :	gage	2026
90 :	sh002i	1960	my $subDisplay = $r->param("subDisplay");
91 :			if (defined $subDisplay) {
92 :	sh002i	1945
93 :	sh002i	1960	if ($subDisplay eq "add_course") {
94 :			if (defined $r->param("add_course")) {
95 :	sh002i	2478	@errors = $self->add_course_validate;
96 :	sh002i	1960	if (@errors) {
97 :	sh002i	2478	$method_to_call = "add_course_form";
98 :	sh002i	1960	} else {
99 :	sh002i	2478	$method_to_call = "do_add_course";
100 :	sh002i	1960	}
101 :			} else {
102 :	sh002i	2478	$method_to_call = "add_course_form";
103 :	sh002i	1960	}
104 :			}
105 :
106 :	sh002i	3059	elsif ($subDisplay eq "rename_course") {
107 :			if (defined $r->param("rename_course")) {
108 :			@errors = $self->rename_course_validate;
109 :			if (@errors) {
110 :			$method_to_call = "rename_course_form";
111 :			} else {
112 :	gage	5980	$method_to_call = "rename_course_confirm";
113 :			}
114 :			} elsif (defined $r->param("confirm_rename_course")) {
115 :			# validate and delete
116 :			@errors = $self->rename_course_validate;
117 :			if (@errors) {
118 :			$method_to_call = "rename_course_form";
119 :			} else {
120 :	sh002i	3059	$method_to_call = "do_rename_course";
121 :			}
122 :	gage	5980	} elsif (defined $r->param("upgrade_course_tables") ){
123 :			# upgrade and revalidate
124 :			@errors = $self->rename_course_validate;
125 :			if (@errors) {
126 :			$method_to_call = "rename_course_form";
127 :			} else {
128 :			$method_to_call = "rename_course_confirm";
129 :			}
130 :
131 :	sh002i	3059	} else {
132 :			$method_to_call = "rename_course_form";
133 :			}
134 :			}
135 :
136 :	sh002i	1960	elsif ($subDisplay eq "delete_course") {
137 :			if (defined $r->param("delete_course")) {
138 :			# validate or confirm
139 :	sh002i	2478	@errors = $self->delete_course_validate;
140 :	sh002i	1960	if (@errors) {
141 :	sh002i	2478	$method_to_call = "delete_course_form";
142 :	sh002i	1960	} else {
143 :	sh002i	2478	$method_to_call = "delete_course_confirm";
144 :	sh002i	1960	}
145 :			} elsif (defined $r->param("confirm_delete_course")) {
146 :			# validate and delete
147 :	sh002i	2478	@errors = $self->delete_course_validate;
148 :	sh002i	1960	if (@errors) {
149 :	sh002i	2478	$method_to_call = "delete_course_form";
150 :	sh002i	1960	} else {
151 :	sh002i	2478	$method_to_call = "do_delete_course";
152 :	sh002i	1960	}
153 :			} else {
154 :			# form only
155 :	sh002i	2478	$method_to_call = "delete_course_form";
156 :	sh002i	1960	}
157 :			}
158 :
159 :	sh002i	1985	elsif ($subDisplay eq "export_database") {
160 :			if (defined $r->param("export_database")) {
161 :	sh002i	2478	@errors = $self->export_database_validate;
162 :	sh002i	1985	if (@errors) {
163 :	sh002i	2478	$method_to_call = "export_database_form";
164 :	sh002i	1985	} else {
165 :	sh002i	2478	# we have to do something special here, since we're sending
166 :			# the database as we export it. $method_to_call still gets
167 :			# set here, but it gets caught by header() and content()
168 :			# below instead of by body().
169 :			$method_to_call = "do_export_database";
170 :	sh002i	1985	}
171 :			} else {
172 :	sh002i	2478	$method_to_call = "export_database_form";
173 :	sh002i	1985	}
174 :			}
175 :
176 :			elsif ($subDisplay eq "import_database") {
177 :			if (defined $r->param("import_database")) {
178 :	sh002i	2478	@errors = $self->import_database_validate;
179 :	sh002i	1985	if (@errors) {
180 :	sh002i	2478	$method_to_call = "import_database_form";
181 :	sh002i	1985	} else {
182 :	sh002i	2478	$method_to_call = "do_import_database";
183 :	sh002i	1985	}
184 :			} else {
185 :	sh002i	2478	$method_to_call = "import_database_form";
186 :	sh002i	1985	}
187 :			}
188 :
189 :	gage	3528	elsif ($subDisplay eq "archive_course") {
190 :			if (defined $r->param("archive_course")) {
191 :			# validate or confirm
192 :			@errors = $self->archive_course_validate;
193 :			if (@errors) {
194 :			$method_to_call = "archive_course_form";
195 :			} else {
196 :			$method_to_call = "archive_course_confirm";
197 :			}
198 :			} elsif (defined $r->param("confirm_archive_course")) {
199 :			# validate and archive
200 :			@errors = $self->archive_course_validate;
201 :			if (@errors) {
202 :			$method_to_call = "archive_course_form";
203 :			} else {
204 :			$method_to_call = "do_archive_course";
205 :			}
206 :	gage	5973	} elsif (defined $r->param("upgrade_course_tables") ){
207 :			# upgrade and revalidate
208 :			@errors = $self->archive_course_validate;
209 :			if (@errors) {
210 :			$method_to_call = "archive_course_form";
211 :			} else {
212 :			$method_to_call = "archive_course_confirm";
213 :			}
214 :	gage	3528	} else {
215 :			# form only
216 :			$method_to_call = "archive_course_form";
217 :			}
218 :			}
219 :	gage	4129	elsif ($subDisplay eq "unarchive_course") {
220 :			if (defined $r->param("unarchive_course")) {
221 :			# validate or confirm
222 :			@errors = $self->unarchive_course_validate;
223 :			if (@errors) {
224 :			$method_to_call = "unarchive_course_form";
225 :			} else {
226 :			$method_to_call = "unarchive_course_confirm";
227 :			}
228 :			} elsif (defined $r->param("confirm_unarchive_course")) {
229 :			# validate and archive
230 :			@errors = $self->unarchive_course_validate;
231 :			if (@errors) {
232 :			$method_to_call = "unarchive_course_form";
233 :			} else {
234 :			$method_to_call = "do_unarchive_course";
235 :			}
236 :			} else {
237 :			# form only
238 :			$method_to_call = "unarchive_course_form";
239 :			}
240 :			}
241 :	glarose	4910	elsif ($subDisplay eq "manage_locations") {
242 :			if (defined ($r->param("manage_location_action"))) {
243 :			$method_to_call =
244 :			$r->param("manage_location_action");
245 :			}
246 :			else{
247 :			$method_to_call = "manage_location_form";
248 :			}
249 :			}
250 :	gage	5664	elsif ($subDisplay eq "registration") {
251 :			if (defined ($r->param("register_site"))) {
252 :			$method_to_call = "do_registration";
253 :			}
254 :			else{
255 :			$method_to_call = "registration_form";
256 :			}
257 :			}
258 :	sh002i	1985	else {
259 :	sh002i	2478	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
260 :	sh002i	1985	}
261 :	sh002i	1960	}
262 :	sh002i	1945
263 :	sh002i	2478	$self->{errors} = \@errors;
264 :			$self->{method_to_call} = $method_to_call;
265 :			}
266 :
267 :			sub header {
268 :			my ($self) = @_;
269 :			my $method_to_call = $self->{method_to_call};
270 :	gage	3235	# if (defined $method_to_call and $method_to_call eq "do_export_database") {
271 :			# my $r = $self->r;
272 :			# my $courseID = $r->param("export_courseID");
273 :			# $r->content_type("application/octet-stream");
274 :			# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
275 :			# $r->send_http_header;
276 :			# } else {
277 :	sh002i	2478	$self->SUPER::header;
278 :	gage	3235	# }
279 :	sh002i	2478	}
280 :
281 :			# sends:
282 :	sh002i	2479	#
283 :	sh002i	2478	# HTTP/1.1 200 OK
284 :			# Date: Fri, 09 Jul 2004 19:05:55 GMT
285 :			# Server: Apache/1.3.27 (Unix) mod_perl/1.27
286 :			# Content-Disposition: attachment; filename="mth143_database.xml"
287 :			# Connection: close
288 :			# Content-Type: application/octet-stream
289 :
290 :			sub content {
291 :			my ($self) = @_;
292 :			my $method_to_call = $self->{method_to_call};
293 :			if (defined $method_to_call and $method_to_call eq "do_export_database") {
294 :	gage	3235	#$self->do_export_database;
295 :			$self->SUPER::content;
296 :	sh002i	2478	} else {
297 :			$self->SUPER::content;
298 :			}
299 :			}
300 :
301 :			sub body {
302 :			my ($self) = @_;
303 :			my $r = $self->r;
304 :			my $ce = $r->ce;
305 :			my $db = $r->db;
306 :			my $authz = $r->authz;
307 :			my $urlpath = $r->urlpath;
308 :
309 :			my $user = $r->param('user');
310 :
311 :			# check permissions
312 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
313 :			return "";
314 :			}
315 :	gage	3235	my $method_to_call = $self->{method_to_call};
316 :			my $methodMessage ="";
317 :	sh002i	2478
318 :	gage	3235	(defined($method_to_call) and $method_to_call eq "do_export_database") && do {
319 :			my @export_courseID = $r->param("export_courseID");
320 :			my $course_ids = join(", ", @export_courseID);
321 :			$methodMessage = CGI::p("Exporting database for course(s) $course_ids").
322 :			CGI::p(".... please wait....
323 :			If your browser times out you will
324 :			still be able to download the exported database using the
325 :			file manager.").CGI::hr();
326 :			};
327 :
328 :
329 :	sh002i	2478	print CGI::p({style=>"text-align: center"},
330 :	gage	3437	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
331 :			add_dbLayout=>'sql_single',
332 :			add_templates_course => $ce->{siteDefaults}->{default_templates_course} \|\|""}
333 :			)},
334 :			"Add Course"
335 :			),
336 :	sh002i	2478	" \| ",
337 :	sh002i	3059	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
338 :			" \| ",
339 :	sh002i	2478	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
340 :			" \| ",
341 :	gage	5679	# CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
342 :			# " \| ",
343 :			# CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
344 :			# " \| ",
345 :	gage	3528	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
346 :	gage	4129	"\|",
347 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"),
348 :	glarose	4910	"\|",
349 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"manage_locations"})}, "Manage Locations"),
350 :	gage	3235	CGI::hr(),
351 :			$methodMessage,
352 :
353 :	sh002i	2478	);
354 :
355 :	gage	5664	print( CGI::p({style=>"text-align: center"}, $self->display_registration_form() ) ) if $self->display_registration_form();
356 :
357 :
358 :	sh002i	2478	my @errors = @{$self->{errors}};
359 :
360 :	gage	3235
361 :	sh002i	2478	if (@errors) {
362 :			print CGI::div({class=>"ResultsWithError"},
363 :			CGI::p("Please correct the following errors and try again:"),
364 :			CGI::ul(CGI::li(\@errors)),
365 :			);
366 :			}
367 :
368 :			if (defined $method_to_call and $method_to_call ne "") {
369 :			$self->$method_to_call;
370 :	gage	3434	} else {
371 :
372 :			print CGI::h2("Courses");
373 :
374 :	gage	3435	print CGI::start_ol();
375 :	gage	3434
376 :			my @courseIDs = listCourses($ce);
377 :			foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
378 :			next if $courseID eq "admin"; # done already above
379 :	apizer	6074	next if $courseID eq "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc
380 :	gage	3434	my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
381 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
382 :			%WeBWorK::SeedCE,
383 :			courseName => $courseID,
384 :			});
385 :	gage	5985
386 :			my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$tempCE);
387 :	gage	5986	my ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($courseID);
388 :	gage	6042	$CIchecker->updateCourseDirectories(); #creates missing html_temp, mailmerge tmpEditFileDir directories;
389 :	gage	5986	my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
390 :	gage	3434	print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
391 :			CGI::code(
392 :			$tempCE->{dbLayoutName},
393 :			),
394 :	apizer	6074	$directories_ok ? "" : CGI::span({style=>"color:red"},"Directory structure or permissions need to be repaired. "),
395 :			$tables_ok ? CGI::span({style=>"color:green"},"Database tables ok") : CGI::span({style=>"color:red"},"Database tables need updating."),
396 :	gage	3434
397 :			);
398 :
399 :			}
400 :
401 :	gage	3435	print CGI::end_ol();
402 :	gage	4129
403 :			print CGI::h2("Archived Courses");
404 :			print CGI::start_ol();
405 :
406 :			@courseIDs = listArchivedCourses($ce);
407 :			foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
408 :			print CGI::li($courseID),
409 :			}
410 :
411 :			print CGI::end_ol();
412 :	sh002i	2478	}
413 :	sh002i	1960	return "";
414 :			}
415 :
416 :	sh002i	1985	################################################################################
417 :
418 :	sh002i	1960	sub add_course_form {
419 :			my ($self) = @_;
420 :			my $r = $self->r;
421 :			my $ce = $r->ce;
422 :			#my $db = $r->db;
423 :			#my $authz = $r->authz;
424 :			#my $urlpath = $r->urlpath;
425 :	sh002i	1945
426 :	gage	5679	my $add_courseID = trim_spaces( $r->param("add_courseID") ) \|\| "";
427 :			my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) \|\| "";
428 :			my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) \|\| "";
429 :	sh002i	2378
430 :	gage	5679	my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) \|\| "";
431 :	sh002i	2378
432 :	gage	5679	my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) \|\| "";
433 :			my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) \|\| "";
434 :			my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) \|\| "";
435 :			my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) \|\| "";
436 :			my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) \|\| "";
437 :			my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) \|\| "";
438 :	sh002i	2378
439 :	gage	5679	my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) \|\| "";
440 :	sh002i	2378
441 :	gage	5679	my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) \|\| "";
442 :	sh002i	1945
443 :	gage	5679
444 :
445 :
446 :	sh002i	2639	my @dbLayouts = do {
447 :			my @ordered_layouts;
448 :	sh002i	4087	foreach my $layout (@{$ce->{dbLayout_order}}) {
449 :	sh002i	2639	if (exists $ce->{dbLayouts}->{$layout}) {
450 :			push @ordered_layouts, $layout;
451 :			}
452 :			}
453 :
454 :			my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
455 :			my @other_layouts;
456 :			foreach my $layout (keys %{ $ce->{dbLayouts} }) {
457 :			unless (exists $ordered_layouts{$layout}) {
458 :			push @other_layouts, $layout;
459 :			}
460 :			}
461 :
462 :			(@ordered_layouts, @other_layouts);
463 :			};
464 :	sh002i	1960
465 :	sh002i	5650	# unused...
466 :			#my $ce2 = new WeBWorK::CourseEnvironment({
467 :			# %WeBWorK::SeedCE,
468 :			# courseName => "COURSENAME",
469 :			#});
470 :	sh002i	1960
471 :	sh002i	2378	my @existingCourses = listCourses($ce);
472 :	gage	3434	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
473 :	sh002i	2148
474 :	sh002i	1960	print CGI::h2("Add Course");
475 :	sh002i	1945
476 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
477 :	sh002i	1960	print $self->hidden_authen_fields;
478 :			print $self->hidden_fields("subDisplay");
479 :	sh002i	1945
480 :	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.");
481 :	sh002i	1960
482 :			print CGI::table({class=>"FormLayout"},
483 :	gage	4280	CGI::Tr({},
484 :	gage	2242	CGI::th({class=>"LeftHeader"}, "Course ID:"),
485 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)),
486 :	sh002i	1960	),
487 :	gage	4280	CGI::Tr({},
488 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Course Title:"),
489 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)),
490 :	gage	2242	),
491 :	gage	4280	CGI::Tr({},
492 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Institution:"),
493 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)),
494 :	gage	2242	),
495 :	sh002i	2378	);
496 :
497 :			print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
498 :	gage	4246	my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
499 :	gage	4280	print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course"));
500 :	sh002i	2378
501 :	gage	4127	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only
502 :			numbers, letters, hyphens, periods (dots), commas,and underscores.\n");
503 :	sh002i	2378
504 :	gage	4280	print CGI::table({class=>"FormLayout"}, CGI::Tr({},
505 :			CGI::td({},
506 :	sh002i	2378	CGI::table({class=>"FormLayout"},
507 :	gage	4280	CGI::Tr({},
508 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "User ID:"),
509 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)),
510 :	sh002i	2378	),
511 :	gage	4280	CGI::Tr({},
512 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Password:"),
513 :	gage	4244	CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)),
514 :	sh002i	2378	),
515 :	gage	4280	CGI::Tr({},
516 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
517 :	gage	4244	CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)),
518 :	sh002i	2378	),
519 :			),
520 :	gage	2299	),
521 :	gage	4280	CGI::td({},
522 :	sh002i	2378	CGI::table({class=>"FormLayout"},
523 :	gage	4280	CGI::Tr({},
524 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "First Name:"),
525 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)),
526 :	sh002i	2378	),
527 :	gage	4280	CGI::Tr({},
528 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Last Name:"),
529 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)),
530 :	sh002i	2378	),
531 :	gage	4280	CGI::Tr({},
532 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Email Address:"),
533 :	gage	4244	CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)),
534 :	sh002i	2378	),
535 :			),
536 :	gage	2242
537 :			),
538 :	sh002i	2378	));
539 :	gage	2254
540 :	sh002i	2378	print CGI::p("To copy problem templates from an existing course, select the course below.");
541 :	gage	2254
542 :			print CGI::table({class=>"FormLayout"},
543 :	gage	4280	CGI::Tr({},
544 :	gage	2254	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
545 :			CGI::td(
546 :			CGI::popup_menu(
547 :			-name => "add_templates_course",
548 :			-values => [ "", @existingCourses ],
549 :			-default => $add_templates_course,
550 :			#-size => 10,
551 :			#-multiple => 0,
552 :			#-labels => \%courseLabels,
553 :			),
554 :
555 :			),
556 :			),
557 :			);
558 :
559 :	sh002i	4357
560 :
561 :	sh002i	2378	print CGI::p("Select a database layout below.");
562 :	gage	4295	print CGI::start_table({class=>"FormLayout"});
563 :	sh002i	4357
564 :			my %dbLayout_buttons;
565 :			my $selected_dbLayout = defined $add_dbLayout ? $add_dbLayout : $ce->{dbLayout_order}[0];
566 :			@dbLayout_buttons{@dbLayouts} = CGI::radio_group(-name=>"add_dbLayout",-values=>\@dbLayouts,-default=>$selected_dbLayout);
567 :	sh002i	1960	foreach my $dbLayout (@dbLayouts) {
568 :	sh002i	4087	my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
569 :			? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
570 :	gage	4295	: "$dbLayout - no description provided in global.conf";
571 :	gage	4280	print CGI::Tr({},
572 :	sh002i	4357	CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}),
573 :	sh002i	2639	CGI::td($dbLayoutLabel),
574 :	sh002i	1945	);
575 :			}
576 :	gage	4295	print CGI::end_table();
577 :			print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course"));
578 :	sh002i	1945
579 :	sh002i	1960	print CGI::end_form();
580 :			}
581 :
582 :			sub add_course_validate {
583 :			my ($self) = @_;
584 :			my $r = $self->r;
585 :			my $ce = $r->ce;
586 :			#my $db = $r->db;
587 :			#my $authz = $r->authz;
588 :			#my $urlpath = $r->urlpath;
589 :
590 :	gage	5679
591 :			my $add_courseID = trim_spaces( $r->param("add_courseID") ) \|\| "";
592 :			my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) \|\| "";
593 :			my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) \|\| "";
594 :	sh002i	2378
595 :	gage	5679	my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) \|\| "";
596 :	sh002i	2378
597 :	gage	5679	my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) \|\| "";
598 :			my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) \|\| "";
599 :			my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) \|\| "";
600 :			my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) \|\| "";
601 :			my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) \|\| "";
602 :			my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) \|\| "";
603 :			my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) \|\| "";
604 :			my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) \|\| "";
605 :	sh002i	2378
606 :	gage	5679
607 :
608 :
609 :			######################
610 :
611 :	sh002i	1960	my @errors;
612 :
613 :			if ($add_courseID eq "") {
614 :	sh002i	2378	push @errors, "You must specify a course ID.";
615 :	sh002i	1960	}
616 :	sh002i	2887	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
617 :			push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
618 :			}
619 :	sh002i	2373	if (grep { $add_courseID eq $_ } listCourses($ce)) {
620 :	sh002i	2378	push @errors, "A course with ID $add_courseID already exists.";
621 :	sh002i	2373	}
622 :	sh002i	4377	#if ($add_courseTitle eq "") {
623 :			# push @errors, "You must specify a course title.";
624 :			#}
625 :			#if ($add_courseInstitution eq "") {
626 :			# push @errors, "You must specify an institution for this course.";
627 :			#}
628 :	sh002i	2378
629 :			if ($add_initial_userID ne "") {
630 :			if ($add_initial_password eq "") {
631 :			push @errors, "You must specify a password for the initial instructor.";
632 :			}
633 :			if ($add_initial_confirmPassword eq "") {
634 :			push @errors, "You must confirm the password for the initial instructor.";
635 :			}
636 :			if ($add_initial_password ne $add_initial_confirmPassword) {
637 :			push @errors, "The password and password confirmation for the instructor must match.";
638 :			}
639 :			if ($add_initial_firstName eq "") {
640 :			push @errors, "You must specify a first name for the initial instructor.";
641 :			}
642 :			if ($add_initial_lastName eq "") {
643 :			push @errors, "You must specify a last name for the initial instructor.";
644 :			}
645 :			if ($add_initial_email eq "") {
646 :			push @errors, "You must specify an email address for the initial instructor.";
647 :			}
648 :	gage	2242	}
649 :	sh002i	1960
650 :			if ($add_dbLayout eq "") {
651 :			push @errors, "You must select a database layout.";
652 :			} else {
653 :			if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
654 :	sh002i	4357	# we used to check for layout-specific fields here, but there aren't any layouts that require them
655 :			# anymore. (in the future, we'll probably deal with this in layout-specific modules.)
656 :	sh002i	1960	} else {
657 :			push @errors, "The database layout $add_dbLayout doesn't exist.";
658 :			}
659 :			}
660 :
661 :			return @errors;
662 :			}
663 :
664 :			sub do_add_course {
665 :			my ($self) = @_;
666 :			my $r = $self->r;
667 :			my $ce = $r->ce;
668 :			my $db = $r->db;
669 :	gage	4127	my $authz = $r->authz;
670 :	sh002i	1960	my $urlpath = $r->urlpath;
671 :
672 :	gage	5679	my $add_courseID = trim_spaces( $r->param("add_courseID") ) \|\| "";
673 :			my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) \|\| "";
674 :			my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) \|\| "";
675 :	sh002i	2378
676 :	gage	5679	my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) \|\| "";
677 :	sh002i	2378
678 :	gage	5679	my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) \|\| "";
679 :			my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) \|\| "";
680 :			my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) \|\| "";
681 :			my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) \|\| "";
682 :			my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) \|\| "";
683 :			my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) \|\| "";
684 :	sh002i	2378
685 :	gage	5679	my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) \|\| "";
686 :	sh002i	2378
687 :	gage	5679	my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) \|\| "";
688 :
689 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
690 :			%WeBWorK::SeedCE,
691 :			courseName => $add_courseID,
692 :			});
693 :	sh002i	1960
694 :	gage	2042	my %courseOptions = ( dbLayoutName => $add_dbLayout );
695 :	sh002i	2384
696 :			if ($add_initial_email ne "") {
697 :			$courseOptions{allowedRecipients} = [ $add_initial_email ];
698 :	sh002i	2853	# don't set feedbackRecipients -- this just gets in the way of the more
699 :			# intelligent "receive_recipients" method.
700 :			#$courseOptions{feedbackRecipients} = [ $add_initial_email ];
701 :	sh002i	2384	}
702 :
703 :	sh002i	4357	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
704 :			# below this line, we would grab values from getopt and put them in this hash
705 :			# but for now the hash can remain empty
706 :	sh002i	1960	my %dbOptions;
707 :	sh002i	2378
708 :	sh002i	1960	my @users;
709 :	sh002i	2378
710 :			# copy users from current (admin) course if desired
711 :			if ($add_admin_users ne "") {
712 :			foreach my $userID ($db->listUsers) {
713 :	sh002i	2887	if ($userID eq $add_initial_userID) {
714 :	gage	3284	$self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
715 :	sh002i	2885	next;
716 :			}
717 :	sh002i	2378	my $User = $db->getUser($userID);
718 :			my $Password = $db->getPassword($userID);
719 :			my $PermissionLevel = $db->getPermissionLevel($userID);
720 :	gage	4127	push @users, [ $User, $Password, $PermissionLevel ]
721 :			if $authz->hasPermissions($userID,"create_and_delete_courses");
722 :			#only transfer the "instructors" in the admin course classlist.
723 :	sh002i	2378	}
724 :			}
725 :
726 :			# add initial instructor if desired
727 :	sh002i	1960	if ($add_initial_userID ne "") {
728 :	sh002i	2004	my $User = $db->newUser(
729 :	sh002i	2384	user_id => $add_initial_userID,
730 :			first_name => $add_initial_firstName,
731 :			last_name => $add_initial_lastName,
732 :			student_id => $add_initial_userID,
733 :			email_address => $add_initial_email,
734 :			status => "C",
735 :	sh002i	2004	);
736 :			my $Password = $db->newPassword(
737 :	sh002i	2378	user_id => $add_initial_userID,
738 :	sh002i	1960	password => cryptPassword($add_initial_password),
739 :	sh002i	2004	);
740 :			my $PermissionLevel = $db->newPermissionLevel(
741 :	sh002i	2378	user_id => $add_initial_userID,
742 :	sh002i	1960	permission => "10",
743 :	sh002i	2004	);
744 :			push @users, [ $User, $Password, $PermissionLevel ];
745 :	sh002i	1960	}
746 :	sh002i	2378
747 :	dpvc	2704	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
748 :	sh002i	2384
749 :	sh002i	2148	my %optional_arguments;
750 :			if ($add_templates_course ne "") {
751 :			$optional_arguments{templatesFrom} = $add_templates_course;
752 :			}
753 :
754 :	sh002i	1960	eval {
755 :			addCourse(
756 :	sh002i	2004	courseID => $add_courseID,
757 :			ce => $ce2,
758 :			courseOptions => \%courseOptions,
759 :			dbOptions => \%dbOptions,
760 :			users => \@users,
761 :	sh002i	2148	%optional_arguments,
762 :	sh002i	1945	);
763 :	sh002i	1960	};
764 :			if ($@) {
765 :			my $error = $@;
766 :			print CGI::div({class=>"ResultsWithError"},
767 :			CGI::p("An error occured while creating the course $add_courseID:"),
768 :			CGI::tt(CGI::escapeHTML($error)),
769 :			);
770 :	gage	2254	# get rid of any partially built courses
771 :			# FIXME -- this is too fragile
772 :			unless ($error =~ /course exists/) {
773 :			eval {
774 :			deleteCourse(
775 :			courseID => $add_courseID,
776 :			ce => $ce2,
777 :			dbOptions => \%dbOptions,
778 :			);
779 :			}
780 :			}
781 :	sh002i	1960	} else {
782 :	gage	2256	#log the action
783 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
784 :			"\tAdded",
785 :	sh002i	4377	( defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)" ),
786 :			( defined $add_courseTitle ? $add_courseTitle : "(no title specified)" ),
787 :	gage	2242	$add_courseID,
788 :	sh002i	2378	$add_initial_firstName,
789 :			$add_initial_lastName,
790 :			$add_initial_email,
791 :	gage	2242	));
792 :	gage	2256	# add contact to admin course as student?
793 :			# FIXME -- should we do this?
794 :	gage	4127	if ($add_initial_userID ne "") {
795 :			my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact
796 :			my $User = $db->newUser(
797 :			user_id => $composite_id, # student id includes school name and contact
798 :			first_name => $add_initial_firstName,
799 :			last_name => $add_initial_lastName,
800 :			student_id => $add_initial_userID,
801 :			email_address => $add_initial_email,
802 :			status => "C",
803 :			);
804 :			my $Password = $db->newPassword(
805 :			user_id => $composite_id,
806 :			password => cryptPassword($add_initial_password),
807 :			);
808 :			my $PermissionLevel = $db->newPermissionLevel(
809 :			user_id => $composite_id,
810 :			permission => "0",
811 :			);
812 :			# add contact to admin course as student
813 :			# or if this contact and course already exist in a dropped status
814 :			# change the student's status to enrolled
815 :			if (my $oldUser = $db->getUser($composite_id) ) {
816 :			warn "Replacing old data for $composite_id status: ". $oldUser->status;
817 :			$db->deleteUser($composite_id);
818 :			}
819 :			eval { $db->addUser($User) }; warn $@ if $@;
820 :			eval { $db->addPassword($Password) }; warn $@ if $@;
821 :			eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@;
822 :			}
823 :	sh002i	1960	print CGI::div({class=>"ResultsWithoutError"},
824 :			CGI::p("Successfully created the course $add_courseID"),
825 :			);
826 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
827 :			courseID => $add_courseID);
828 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
829 :			print CGI::div({style=>"text-align: center"},
830 :			CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
831 :			);
832 :			}
833 :	gage	2322
834 :	gage	2299
835 :	sh002i	1960	}
836 :
837 :			################################################################################
838 :
839 :	sh002i	3059	sub rename_course_form {
840 :			my ($self) = @_;
841 :			my $r = $self->r;
842 :			my $ce = $r->ce;
843 :			#my $db = $r->db;
844 :			#my $authz = $r->authz;
845 :			#my $urlpath = $r->urlpath;
846 :
847 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
848 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
849 :
850 :			my @courseIDs = listCourses($ce);
851 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
852 :	sh002i	3059
853 :			my %courseLabels; # records... heh.
854 :			foreach my $courseID (@courseIDs) {
855 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
856 :			%WeBWorK::SeedCE,
857 :			courseName => $courseID,
858 :			});
859 :	sh002i	3059	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
860 :			}
861 :
862 :			print CGI::h2("Rename Course");
863 :
864 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
865 :	sh002i	3059	print $self->hidden_authen_fields;
866 :			print $self->hidden_fields("subDisplay");
867 :
868 :			print CGI::p("Select a course to rename.");
869 :
870 :			print CGI::table({class=>"FormLayout"},
871 :	gage	4280	CGI::Tr({},
872 :	sh002i	3059	CGI::th({class=>"LeftHeader"}, "Course Name:"),
873 :			CGI::td(
874 :			CGI::scrolling_list(
875 :			-name => "rename_oldCourseID",
876 :			-values => \@courseIDs,
877 :			-default => $rename_oldCourseID,
878 :			-size => 10,
879 :			-multiple => 0,
880 :			-labels => \%courseLabels,
881 :			),
882 :			),
883 :			),
884 :	gage	4280	CGI::Tr({},
885 :	sh002i	3059	CGI::th({class=>"LeftHeader"}, "New Name:"),
886 :	gage	4244	CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)),
887 :	sh002i	3059	),
888 :			);
889 :
890 :			print CGI::end_table();
891 :
892 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course"));
893 :	sh002i	3059
894 :			print CGI::end_form();
895 :			}
896 :	gage	5980	sub rename_course_confirm {
897 :	sh002i	3059
898 :	gage	5980	my ($self) = @_;
899 :			my $r = $self->r;
900 :			my $ce = $r->ce;
901 :			#my $db = $r->db;
902 :			#my $authz = $r->authz;
903 :			#my $urlpath = $r->urlpath;
904 :
905 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
906 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
907 :
908 :			my $ce2 = new WeBWorK::CourseEnvironment({
909 :			%WeBWorK::SeedCE,
910 :			courseName => $rename_oldCourseID,
911 :			});
912 :	gage	5986	#############################################################################
913 :			# Check database
914 :			#############################################################################
915 :	gage	5980
916 :	gage	5985	my ($tables_ok,$dbStatus);
917 :	gage	5980	if ($ce2->{dbLayoutName} ) {
918 :	gage	5985	my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
919 :			($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID);
920 :			if ($r->param("upgrade_course_tables")) {
921 :			my @schema_table_names = keys %$dbStatus; # update tables missing from database;
922 :			my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names;
923 :			my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names;
924 :			my $msg = $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create]);
925 :			foreach my $table_name (@tables_to_alter) {
926 :			$msg .= $CIchecker->updateTableFields($rename_oldCourseID, $table_name);
927 :			}
928 :	gage	5980	print CGI::p({-style=>'color:green; font-weight:bold'}, $msg);
929 :	gage	6004
930 :	gage	5980	}
931 :	gage	5985	($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID);
932 :
933 :
934 :			# print db status
935 :
936 :			my %msg =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"),
937 :			WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"),
938 :			WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," Table is ok "),
939 :			WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "),
940 :			);
941 :			my %msg2 =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," missing in database"),
942 :			WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," missing in schema"),
943 :			WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," is ok "),
944 :			WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "),
945 :			);
946 :			my $all_tables_ok=1;
947 :			my $extra_database_tables=0;
948 :			my $extra_database_fields=0;
949 :			my $str=CGI::h4("Report on database structure for course $rename_oldCourseID:").CGI::br();
950 :			foreach my $table (sort keys %$dbStatus) {
951 :			my $table_status = $dbStatus->{$table}->[0];
952 :			$str .= CGI::b($table) . $msg{ $table_status } . CGI::br();
953 :
954 :			CASE: {
955 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B
956 :			&& do{ last CASE;
957 :			};
958 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
959 :			&& do{
960 :			$all_tables_ok = 0; last CASE;
961 :			};
962 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
963 :			&& do{
964 :			$extra_database_tables = 1; last CASE;
965 :			};
966 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B
967 :			&& do{
968 :			my %fieldInfo = %{ $dbStatus->{$table}->[1] };
969 :			foreach my $key (keys %fieldInfo) {
970 :			my $field_status = $fieldInfo{$key}->[0];
971 :			CASE2: {
972 :			$field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
973 :			&& do{
974 :			$extra_database_fields = 1; last CASE2;
975 :			};
976 :			$field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
977 :			&& do{
978 :			$all_tables_ok=0; last CASE2;
979 :			};
980 :			}
981 :			$str .= CGI::br()."\n  Field $key => ". $msg2{$field_status };
982 :			}
983 :			};
984 :			}
985 :			$str.=CGI::br();
986 :
987 :	gage	5980	}
988 :	gage	5986	#############################################################################
989 :			# Report on databases
990 :			#############################################################################
991 :
992 :	gage	5980	print CGI::p($str);
993 :	gage	5985	if ($extra_database_tables) {
994 :			print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
995 :			They can only be removed manually from the database. They will not be renamed.");
996 :			}
997 :			if ($extra_database_fields) {
998 :			print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields which are not defined in the schema for at least one table.
999 :			They can only be removed manually from the database.");
1000 :	gage	5986	}
1001 :	gage	5985	if ($all_tables_ok) {
1002 :			print CGI::p({-style=>'color:green; font-weight:bold'},"Course $rename_oldCourseID database is in order");
1003 :	gage	5980	} else {
1004 :			print CGI::p({-style=>'color:red; font-weight:bold'}, "Course $rename_oldCourseID databases must be updated before renaming this course.");
1005 :	gage	5986	}
1006 :
1007 :			#############################################################################
1008 :			# Check directories
1009 :			#############################################################################
1010 :
1011 :
1012 :			my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2);
1013 :			my $style = ($directories_ok)?"color:green" : "color:red";
1014 :			print CGI::h2("Directory structure"), CGI::p($str2),
1015 :			($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
1016 :			CGI::p({style=>$style},"Directory structure is missing directories
1017 :			or the webserver lacks sufficient privileges.");
1018 :
1019 :			#############################################################################
1020 :			# Print form for choosing next action.
1021 :			#############################################################################
1022 :
1023 :
1024 :
1025 :	gage	5980	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1026 :			print $self->hidden_authen_fields;
1027 :			print $self->hidden_fields("subDisplay");
1028 :			print $self->hidden_fields(qw/rename_oldCourseID rename_newCourseID/);
1029 :			# grab some values we'll need
1030 :			# fail if the source course does not exist
1031 :
1032 :
1033 :
1034 :	gage	5986	if ($all_tables_ok && $directories_ok ) { # no missing tables or missing fields or directories
1035 :	gage	5980	print CGI::p({style=>"text-align: center"},
1036 :			CGI::submit(-name=>"decline_rename_course", -value=>"Don't rename"),
1037 :			" ",
1038 :			CGI::submit(-name=>"confirm_rename_course", -value=>"Rename") ,
1039 :			);
1040 :	gage	5986	} elsif( $directories_ok ) {
1041 :	gage	5980	print CGI::p({style=>"text-align: center"},
1042 :			CGI::submit(-name => "decline_rename_course", -value => "Don't rename"),
1043 :			" ",
1044 :			CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"),
1045 :			);
1046 :	gage	5986	} else {
1047 :			print CGI::p({style=>"text-align: center"},
1048 :			CGI::submit(-name => "decline_rename_course", -value => "Don't rename"),
1049 :			CGI::br(),"Directory structure needs to be repaired manually before renaming."
1050 :			);
1051 :	gage	5985	}
1052 :	gage	5980	}
1053 :			}
1054 :	sh002i	3059	sub rename_course_validate {
1055 :			my ($self) = @_;
1056 :			my $r = $self->r;
1057 :			my $ce = $r->ce;
1058 :			#my $db = $r->db;
1059 :			#my $authz = $r->authz;
1060 :			#my $urlpath = $r->urlpath;
1061 :
1062 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
1063 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
1064 :
1065 :			my @errors;
1066 :
1067 :			if ($rename_oldCourseID eq "") {
1068 :			push @errors, "You must select a course to rename.";
1069 :			}
1070 :			if ($rename_newCourseID eq "") {
1071 :			push @errors, "You must specify a new name for the course.";
1072 :			}
1073 :			if ($rename_oldCourseID eq $rename_newCourseID) {
1074 :			push @errors, "Can't rename to the same name.";
1075 :			}
1076 :			unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
1077 :			push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
1078 :			}
1079 :			if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
1080 :			push @errors, "A course with ID $rename_newCourseID already exists.";
1081 :			}
1082 :
1083 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1084 :			%WeBWorK::SeedCE,
1085 :			courseName => $rename_oldCourseID,
1086 :			});
1087 :	sh002i	3059
1088 :			return @errors;
1089 :			}
1090 :
1091 :			sub do_rename_course {
1092 :			my ($self) = @_;
1093 :			my $r = $self->r;
1094 :			my $ce = $r->ce;
1095 :			my $db = $r->db;
1096 :			#my $authz = $r->authz;
1097 :			my $urlpath = $r->urlpath;
1098 :
1099 :			my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
1100 :			my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
1101 :
1102 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1103 :			%WeBWorK::SeedCE,
1104 :			courseName => $rename_oldCourseID,
1105 :			});
1106 :	sh002i	3059
1107 :			my $dbLayoutName = $ce->{dbLayoutName};
1108 :
1109 :	sh002i	4357	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
1110 :			# below this line, we would grab values from getopt and put them in this hash
1111 :			# but for now the hash can remain empty
1112 :	sh002i	3059	my %dbOptions;
1113 :
1114 :			eval {
1115 :			renameCourse(
1116 :			courseID => $rename_oldCourseID,
1117 :			ce => $ce2,
1118 :			dbOptions => \%dbOptions,
1119 :			newCourseID => $rename_newCourseID,
1120 :			);
1121 :			};
1122 :			if ($@) {
1123 :			my $error = $@;
1124 :			print CGI::div({class=>"ResultsWithError"},
1125 :			CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
1126 :			CGI::tt(CGI::escapeHTML($error)),
1127 :			);
1128 :			} else {
1129 :			print CGI::div({class=>"ResultsWithoutError"},
1130 :			CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
1131 :			);
1132 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
1133 :			courseID => $rename_newCourseID);
1134 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
1135 :			print CGI::div({style=>"text-align: center"},
1136 :			CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
1137 :			);
1138 :			}
1139 :			}
1140 :
1141 :			################################################################################
1142 :
1143 :	sh002i	1960	sub delete_course_form {
1144 :			my ($self) = @_;
1145 :			my $r = $self->r;
1146 :			my $ce = $r->ce;
1147 :			#my $db = $r->db;
1148 :			#my $authz = $r->authz;
1149 :			#my $urlpath = $r->urlpath;
1150 :
1151 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1152 :
1153 :			my @courseIDs = listCourses($ce);
1154 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1155 :	sh002i	1960
1156 :			my %courseLabels; # records... heh.
1157 :			foreach my $courseID (@courseIDs) {
1158 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
1159 :			%WeBWorK::SeedCE,
1160 :			courseName => $courseID,
1161 :			});
1162 :	sh002i	1960	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1163 :			}
1164 :
1165 :			print CGI::h2("Delete Course");
1166 :
1167 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1168 :	sh002i	1960	print $self->hidden_authen_fields;
1169 :			print $self->hidden_fields("subDisplay");
1170 :
1171 :			print CGI::p("Select a course to delete.");
1172 :
1173 :			print CGI::table({class=>"FormLayout"},
1174 :	gage	4280	CGI::Tr({},
1175 :	sh002i	1960	CGI::th({class=>"LeftHeader"}, "Course Name:"),
1176 :	sh002i	1945	CGI::td(
1177 :	sh002i	1960	CGI::scrolling_list(
1178 :			-name => "delete_courseID",
1179 :			-values => \@courseIDs,
1180 :			-default => $delete_courseID,
1181 :			-size => 10,
1182 :			-multiple => 0,
1183 :			-labels => \%courseLabels,
1184 :	sh002i	1945	),
1185 :			),
1186 :	sh002i	1960	),
1187 :			);
1188 :
1189 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course"));
1190 :	sh002i	1960
1191 :			print CGI::end_form();
1192 :			}
1193 :
1194 :			sub delete_course_validate {
1195 :			my ($self) = @_;
1196 :			my $r = $self->r;
1197 :			my $ce = $r->ce;
1198 :			#my $db = $r->db;
1199 :			#my $authz = $r->authz;
1200 :			my $urlpath = $r->urlpath;
1201 :
1202 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1203 :
1204 :			my @errors;
1205 :
1206 :			if ($delete_courseID eq "") {
1207 :			push @errors, "You must specify a course name.";
1208 :			} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
1209 :			push @errors, "You cannot delete the course you are currently using.";
1210 :			}
1211 :
1212 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1213 :			%WeBWorK::SeedCE,
1214 :			courseName => $delete_courseID,
1215 :			});
1216 :	sh002i	1960
1217 :			return @errors;
1218 :			}
1219 :
1220 :			sub delete_course_confirm {
1221 :			my ($self) = @_;
1222 :			my $r = $self->r;
1223 :			my $ce = $r->ce;
1224 :			#my $db = $r->db;
1225 :			#my $authz = $r->authz;
1226 :			#my $urlpath = $r->urlpath;
1227 :
1228 :			print CGI::h2("Delete Course");
1229 :
1230 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1231 :
1232 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1233 :			%WeBWorK::SeedCE,
1234 :			courseName => $delete_courseID,
1235 :			});
1236 :	sh002i	1960
1237 :	sh002i	4357	print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
1238 :			. "? All course files and data will be destroyed. There is no undo available.");
1239 :	sh002i	1945
1240 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1241 :	sh002i	1960	print $self->hidden_authen_fields;
1242 :			print $self->hidden_fields("subDisplay");
1243 :	sh002i	4357	print $self->hidden_fields(qw/delete_courseID/);
1244 :	sh002i	1960
1245 :			print CGI::p({style=>"text-align: center"},
1246 :	gage	4244	CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"),
1247 :	sh002i	1960	" ",
1248 :	gage	4244	CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"),
1249 :	sh002i	1960	);
1250 :
1251 :			print CGI::end_form();
1252 :			}
1253 :
1254 :			sub do_delete_course {
1255 :			my ($self) = @_;
1256 :			my $r = $self->r;
1257 :			my $ce = $r->ce;
1258 :	gage	4127	my $db = $r->db;
1259 :	sh002i	1960	#my $authz = $r->authz;
1260 :			#my $urlpath = $r->urlpath;
1261 :
1262 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
1263 :
1264 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1265 :			%WeBWorK::SeedCE,
1266 :			courseName => $delete_courseID,
1267 :			});
1268 :	sh002i	1960
1269 :	sh002i	4357	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
1270 :			# below this line, we would grab values from getopt and put them in this hash
1271 :			# but for now the hash can remain empty
1272 :	sh002i	1960	my %dbOptions;
1273 :
1274 :			eval {
1275 :			deleteCourse(
1276 :			courseID => $delete_courseID,
1277 :			ce => $ce2,
1278 :			dbOptions => \%dbOptions,
1279 :			);
1280 :			};
1281 :
1282 :			if ($@) {
1283 :			my $error = $@;
1284 :			print CGI::div({class=>"ResultsWithError"},
1285 :			CGI::p("An error occured while deleting the course $delete_courseID:"),
1286 :			CGI::tt(CGI::escapeHTML($error)),
1287 :			);
1288 :			} else {
1289 :	gage	4127	# mark the contact person in the admin course as dropped.
1290 :			# find the contact person for the course by searching the admin classlist.
1291 :			my @contacts = grep /_$delete_courseID$/, $db->listUsers;
1292 :	sh002i	4311	if (@contacts) {
1293 :			die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1;
1294 :			#warn "contacts", join(" ", @contacts);
1295 :			#my $composite_id = "${add_initial_userID}_${add_courseID}";
1296 :			my $composite_id = $contacts[0];
1297 :
1298 :			# mark the contact person as dropped.
1299 :			my $User = $db->getUser($composite_id);
1300 :			my $status_name = 'Drop';
1301 :			my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
1302 :			$User->status($status_value);
1303 :			$db->putUser($User);
1304 :			}
1305 :	gage	4127
1306 :	sh002i	1960	print CGI::div({class=>"ResultsWithoutError"},
1307 :	sh002i	2378	CGI::p("Successfully deleted the course $delete_courseID."),
1308 :	sh002i	1960	);
1309 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
1310 :			"\tDeleted",
1311 :			"",
1312 :			"",
1313 :			$delete_courseID,
1314 :			));
1315 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1316 :	sh002i	1945	print $self->hidden_authen_fields;
1317 :	sh002i	1960	print $self->hidden_fields("subDisplay");
1318 :	sh002i	1945
1319 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),);
1320 :	sh002i	1945
1321 :	sh002i	1960	print CGI::end_form();
1322 :	sh002i	1945	}
1323 :			}
1324 :
1325 :	sh002i	1985	################################################################################
1326 :
1327 :			sub export_database_form {
1328 :			my ($self) = @_;
1329 :			my $r = $self->r;
1330 :			my $ce = $r->ce;
1331 :			#my $db = $r->db;
1332 :			#my $authz = $r->authz;
1333 :			#my $urlpath = $r->urlpath;
1334 :
1335 :			my @tables = keys %{$ce->{dbLayout}};
1336 :
1337 :			my $export_courseID = $r->param("export_courseID") \|\| "";
1338 :			my @export_tables = $r->param("export_tables");
1339 :	gage	3235
1340 :	sh002i	1985	@export_tables = @tables unless @export_tables;
1341 :
1342 :			my @courseIDs = listCourses($ce);
1343 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1344 :	sh002i	1985
1345 :			my %courseLabels; # records... heh.
1346 :			foreach my $courseID (@courseIDs) {
1347 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
1348 :			%WeBWorK::SeedCE,
1349 :			courseName => $courseID,
1350 :			});
1351 :	sh002i	1985	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1352 :			}
1353 :
1354 :			print CGI::h2("Export Database");
1355 :
1356 :	sh002i	4312	print CGI::p(IMPORT_EXPORT_WARNING);
1357 :
1358 :	gage	4244	print CGI::start_form(-method=>"GET", -action=>$r->uri);
1359 :	sh002i	1985	print $self->hidden_authen_fields;
1360 :			print $self->hidden_fields("subDisplay");
1361 :
1362 :	gage	4280	print CGI::p({},"Select a course to export the course's database. Please note
1363 :	sh002i	2844	that exporting can take a very long time for a large course. If you have
1364 :			shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
1365 :			utility instead.");
1366 :	sh002i	1985
1367 :			print CGI::table({class=>"FormLayout"},
1368 :	gage	4280	CGI::Tr({},
1369 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Course Name:"),
1370 :			CGI::td(
1371 :			CGI::scrolling_list(
1372 :			-name => "export_courseID",
1373 :			-values => \@courseIDs,
1374 :			-default => $export_courseID,
1375 :			-size => 10,
1376 :	gage	3235	-multiple => 1,
1377 :	sh002i	1985	-labels => \%courseLabels,
1378 :			),
1379 :			),
1380 :			),
1381 :	gage	4280	CGI::Tr({},
1382 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
1383 :	gage	4280	CGI::td({},
1384 :	sh002i	1985	CGI::checkbox_group(
1385 :			-name => "export_tables",
1386 :			-values => \@tables,
1387 :			-default => \@export_tables,
1388 :			-linebreak => 1,
1389 :			),
1390 :			),
1391 :			),
1392 :			);
1393 :
1394 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database"));
1395 :	sh002i	1985
1396 :			print CGI::end_form();
1397 :			}
1398 :
1399 :			sub export_database_validate {
1400 :			my ($self) = @_;
1401 :			my $r = $self->r;
1402 :			#my $ce = $r->ce;
1403 :			#my $db = $r->db;
1404 :			#my $authz = $r->authz;
1405 :			#my $urlpath = $r->urlpath;
1406 :
1407 :	gage	3235	my @export_courseID = $r->param("export_courseID") \|\| ();
1408 :	sh002i	1985	my @export_tables = $r->param("export_tables");
1409 :	gage	3235
1410 :	sh002i	1985	my @errors;
1411 :	gage	3235
1412 :			unless ( @export_courseID) {
1413 :			push @errors, "You must specify at least one course name.";
1414 :	sh002i	1985	}
1415 :
1416 :			unless (@export_tables) {
1417 :			push @errors, "You must specify at least one table to export.";
1418 :			}
1419 :
1420 :			return @errors;
1421 :			}
1422 :
1423 :			sub do_export_database {
1424 :			my ($self) = @_;
1425 :			my $r = $self->r;
1426 :			my $ce = $r->ce;
1427 :			#my $db = $r->db;
1428 :			#my $authz = $r->authz;
1429 :			my $urlpath = $r->urlpath;
1430 :
1431 :	gage	3235	my @export_courseID = $r->param("export_courseID");
1432 :	sh002i	1985	my @export_tables = $r->param("export_tables");
1433 :
1434 :	gage	3235	foreach my $export_courseID (@export_courseID) {
1435 :
1436 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1437 :			%WeBWorK::SeedCE,
1438 :			courseName => $export_courseID,
1439 :			});
1440 :	gage	3235
1441 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1442 :
1443 :			#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1444 :			#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1445 :			# export to the admin/templates directory
1446 :			my $exportFileName = "$export_courseID.exported.xml";
1447 :			my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
1448 :			# get a unique name
1449 :			my $number =1;
1450 :			while (-e "$exportFilePath.$number.gz") {
1451 :			$number++;
1452 :			last if $number>9;
1453 :			}
1454 :			if ($number<=9 ) {
1455 :			$exportFilePath = "$exportFilePath.$number";
1456 :			$exportFileName = "$exportFileName.$number";
1457 :			} else {
1458 :			$self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
1459 :			remove some of these files."));
1460 :			$exportFilePath = "$exportFilePath.999";
1461 :			$exportFileName = "$exportFileName.999";
1462 :			}
1463 :	sh002i	1985
1464 :	gage	3235	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1465 :	sh002i	1985
1466 :	gage	3235	my @errors;
1467 :			eval {
1468 :			@errors = dbExport(
1469 :			db => $db2,
1470 :			#xml => $fh,
1471 :			xml => $outputFileHandle,
1472 :			tables => \@export_tables,
1473 :			);
1474 :			};
1475 :
1476 :			$outputFileHandle->close();
1477 :	sh002i	1985
1478 :	sh002i	5020	my $gzipMessage = system($ce->{externalPrograms}{gzip}, $exportFilePath);
1479 :	glarose	4910	if ( !$gzipMessage ) {
1480 :	sh002i	5020	$self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gz.
1481 :	glarose	4910	You may download it with the file manager."));
1482 :	gage	3235	} else {
1483 :	glarose	4910	$self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
1484 :	gage	3235	}
1485 :			unlink $exportFilePath;
1486 :			} # end export of one course
1487 :	sh002i	2478	#push @errors, "Fatal exception: $@" if $@;
1488 :			#
1489 :			#if (@errors) {
1490 :			# print CGI::div({class=>"ResultsWithError"},
1491 :			# CGI::p("An error occured while exporting the database of course $export_courseID:"),
1492 :			# CGI::ul(CGI::li(\@errors)),
1493 :			# );
1494 :			#} else {
1495 :			# print CGI::div({class=>"ResultsWithoutError"},
1496 :			# CGI::p("Export succeeded."),
1497 :			# );
1498 :			#
1499 :			# print CGI::div({style=>"text-align: center"},
1500 :			# CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1501 :			# );
1502 :			#}
1503 :	sh002i	1985	}
1504 :
1505 :			################################################################################
1506 :
1507 :			sub import_database_form {
1508 :			my ($self) = @_;
1509 :			my $r = $self->r;
1510 :			my $ce = $r->ce;
1511 :			#my $db = $r->db;
1512 :			#my $authz = $r->authz;
1513 :			#my $urlpath = $r->urlpath;
1514 :
1515 :			my @tables = keys %{$ce->{dbLayout}};
1516 :
1517 :			my $import_file = $r->param("import_file") \|\| "";
1518 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1519 :			my @import_tables = $r->param("import_tables");
1520 :			my $import_conflict = $r->param("import_conflict") \|\| "skip";
1521 :
1522 :			@import_tables = @tables unless @import_tables;
1523 :
1524 :			my @courseIDs = listCourses($ce);
1525 :	gage	3434	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1526 :	gage	2045
1527 :	sh002i	1985
1528 :			my %courseLabels; # records... heh.
1529 :			foreach my $courseID (@courseIDs) {
1530 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
1531 :			%WeBWorK::SeedCE,
1532 :			courseName => $courseID,
1533 :			});
1534 :	sh002i	1985	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1535 :			}
1536 :
1537 :	gage	3235	# find databases:
1538 :			my $templatesDir = $ce->{courseDirs}->{templates};
1539 :	sh002i	4642	my $exempt_dirs = join("\|", keys %{ $r->ce->{courseFiles}->{problibs} });
1540 :	gage	3235
1541 :			my @databaseFiles = listFilesRecursive(
1542 :			$templatesDir,
1543 :			qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
1544 :			qr/^(?:$exempt_dirs\|CVS)$/, # prune these directories
1545 :			0, # match against file name only
1546 :			1, # prune against path relative to $templatesDir
1547 :			);
1548 :
1549 :			my %databaseLabels = map { ($_ => $_) } @databaseFiles;
1550 :
1551 :			#######
1552 :
1553 :	sh002i	1985	print CGI::h2("Import Database");
1554 :
1555 :	sh002i	4312	print CGI::p(IMPORT_EXPORT_WARNING);
1556 :
1557 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART);
1558 :	sh002i	1985	print $self->hidden_authen_fields;
1559 :			print $self->hidden_fields("subDisplay");
1560 :
1561 :			print CGI::table({class=>"FormLayout"},
1562 :	gage	4280	CGI::Tr({},
1563 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1564 :			CGI::td(
1565 :	gage	3235	CGI::scrolling_list(
1566 :	sh002i	1985	-name => "import_file",
1567 :	gage	3235	-values => \@databaseFiles,
1568 :			-default => undef,
1569 :			-size => 10,
1570 :			-multiple => 0,
1571 :			-labels => \%databaseLabels,
1572 :	sh002i	1985	),
1573 :	gage	3235
1574 :			)
1575 :	sh002i	1985	),
1576 :	gage	4280	CGI::Tr({},
1577 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1578 :			CGI::td(
1579 :			CGI::checkbox_group(
1580 :			-name => "import_tables",
1581 :			-values => \@tables,
1582 :			-default => \@import_tables,
1583 :			-linebreak => 1,
1584 :			),
1585 :			),
1586 :			),
1587 :	gage	4280	CGI::Tr({},
1588 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1589 :			CGI::td(
1590 :			CGI::scrolling_list(
1591 :			-name => "import_courseID",
1592 :			-values => \@courseIDs,
1593 :			-default => $import_courseID,
1594 :			-size => 10,
1595 :			-multiple => 0,
1596 :			-labels => \%courseLabels,
1597 :			),
1598 :			),
1599 :			),
1600 :	gage	4280	CGI::Tr({},
1601 :	sh002i	1985	CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1602 :			CGI::td(
1603 :			CGI::radio_group(
1604 :			-name => "import_conflict",
1605 :			-values => [qw/skip replace/],
1606 :			-default => $import_conflict,
1607 :			-linebreak=>'true',
1608 :			-labels => {
1609 :			skip => "Skip duplicate records",
1610 :			replace => "Replace duplicate records",
1611 :			},
1612 :			),
1613 :			),
1614 :			),
1615 :			);
1616 :
1617 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database"));
1618 :	sh002i	1985
1619 :			print CGI::end_form();
1620 :			}
1621 :
1622 :			sub import_database_validate {
1623 :			my ($self) = @_;
1624 :			my $r = $self->r;
1625 :			#my $ce = $r->ce;
1626 :			#my $db = $r->db;
1627 :			#my $authz = $r->authz;
1628 :			#my $urlpath = $r->urlpath;
1629 :
1630 :			my $import_file = $r->param("import_file") \|\| "";
1631 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1632 :			my @import_tables = $r->param("import_tables");
1633 :			#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1634 :
1635 :			my @errors;
1636 :
1637 :			if ($import_file eq "") {
1638 :	gage	3235	push @errors, "You must specify a database file to import.";
1639 :	sh002i	1985	}
1640 :
1641 :			if ($import_courseID eq "") {
1642 :			push @errors, "You must specify a course name.";
1643 :			}
1644 :
1645 :			unless (@import_tables) {
1646 :			push @errors, "You must specify at least one table to import.";
1647 :			}
1648 :
1649 :			return @errors;
1650 :			}
1651 :
1652 :			sub do_import_database {
1653 :			my ($self) = @_;
1654 :			my $r = $self->r;
1655 :			my $ce = $r->ce;
1656 :			#my $db = $r->db;
1657 :			#my $authz = $r->authz;
1658 :			my $urlpath = $r->urlpath;
1659 :
1660 :			my $import_file = $r->param("import_file");
1661 :			my $import_courseID = $r->param("import_courseID");
1662 :			my @import_tables = $r->param("import_tables");
1663 :			my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
1664 :
1665 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1666 :			%WeBWorK::SeedCE,
1667 :			courseName => $import_courseID,
1668 :			});
1669 :	sh002i	1985
1670 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1671 :
1672 :	gage	3235	# locate file
1673 :			my $templateDir = $ce->{courseDirs}->{templates};
1674 :			my $filePath = "$templateDir/$import_file";
1675 :
1676 :	glarose	4910	my $gunzipMessage = system( 'gunzip', $filePath);
1677 :			#FIXME
1678 :			#warn "gunzip ", $gunzipMessage;
1679 :			$filePath =~ s/\.gz$//;
1680 :			#warn "new file path is $filePath";
1681 :			my $fileHandle = new IO::File("<$filePath");
1682 :			# retrieve upload from upload cache
1683 :	gage	3235	# my ($id, $hash) = split /\s+/, $import_file;
1684 :			# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1685 :			# dir => $ce->{webworkDirs}->{uploadCache}
1686 :			# );
1687 :	sh002i	1985
1688 :			my @errors;
1689 :
1690 :	glarose	4910	eval {
1691 :			@errors = dbImport(
1692 :			db => $db2,
1693 :			# xml => $upload->fileHandle,
1694 :			xml => $fileHandle,
1695 :			tables => \@import_tables,
1696 :			conflict => $import_conflict,
1697 :			);
1698 :			};
1699 :	sh002i	1985
1700 :	glarose	4910	push @errors, "Fatal exception: $@" if $@;
1701 :			push @errors, $gunzipMessage if $gunzipMessage;
1702 :
1703 :	sh002i	1985	if (@errors) {
1704 :			print CGI::div({class=>"ResultsWithError"},
1705 :			CGI::p("An error occured while importing the database of course $import_courseID:"),
1706 :			CGI::ul(CGI::li(\@errors)),
1707 :			);
1708 :			} else {
1709 :			print CGI::div({class=>"ResultsWithoutError"},
1710 :			CGI::p("Import succeeded."),
1711 :			);
1712 :			}
1713 :			}
1714 :	sh002i	5207	################################################################################
1715 :
1716 :	gage	3528	sub archive_course_form {
1717 :			my ($self) = @_;
1718 :			my $r = $self->r;
1719 :			my $ce = $r->ce;
1720 :			#my $db = $r->db;
1721 :			#my $authz = $r->authz;
1722 :			#my $urlpath = $r->urlpath;
1723 :
1724 :			my $archive_courseID = $r->param("archive_courseID") \|\| "";
1725 :
1726 :			my @courseIDs = listCourses($ce);
1727 :			@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1728 :
1729 :			my %courseLabels; # records... heh.
1730 :			foreach my $courseID (@courseIDs) {
1731 :	sh002i	5221	my $tempCE = new WeBWorK::CourseEnvironment({
1732 :			%WeBWorK::SeedCE,
1733 :			courseName => $courseID,
1734 :			});
1735 :	gage	3528	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1736 :			}
1737 :
1738 :			print CGI::h2("archive Course");
1739 :
1740 :	sh002i	5207	print CGI::p(
1741 :			"Creates a gzipped tar archive (.tar.gz) of a course in the WeBWorK
1742 :			courses directory. Before archiving, the course database is dumped into
1743 :			a subdirectory of the course's DATA directory. Currently the archive
1744 :			facility is only available for mysql databases. It depends on the
1745 :			mysqldump application."
1746 :			);
1747 :
1748 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1749 :	gage	3528	print $self->hidden_authen_fields;
1750 :			print $self->hidden_fields("subDisplay");
1751 :
1752 :			print CGI::p("Select a course to archive.");
1753 :
1754 :			print CGI::table({class=>"FormLayout"},
1755 :	gage	4280	CGI::Tr({},
1756 :	gage	3528	CGI::th({class=>"LeftHeader"}, "Course Name:"),
1757 :			CGI::td(
1758 :			CGI::scrolling_list(
1759 :	gage	6175	-name => "archive_courseIDs",
1760 :	gage	3528	-values => \@courseIDs,
1761 :			-default => $archive_courseID,
1762 :			-size => 10,
1763 :	gage	6175	-multiple => 1,
1764 :	gage	3528	-labels => \%courseLabels,
1765 :			),
1766 :			),
1767 :	gage	4136
1768 :	gage	3528	),
1769 :	gage	4280	CGI::Tr({},
1770 :	gage	4136	CGI::th({class=>"LeftHeader"}, "Delete course:"),
1771 :			CGI::td({-style=>'color:red'}, CGI::checkbox({
1772 :			-name=>'delete_course',
1773 :			-checked=>0,
1774 :			-value => 1,
1775 :			-label =>'Delete course after archiving. Caution there is no undo!',
1776 :			},
1777 :			),
1778 :			),
1779 :			)
1780 :	gage	3528	);
1781 :
1782 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course", -value=>"archive Course"));
1783 :	gage	3528
1784 :			print CGI::end_form();
1785 :			}
1786 :	sh002i	1985
1787 :	gage	3528	sub archive_course_validate {
1788 :			my ($self) = @_;
1789 :			my $r = $self->r;
1790 :			my $ce = $r->ce;
1791 :			#my $db = $r->db;
1792 :			#my $authz = $r->authz;
1793 :			my $urlpath = $r->urlpath;
1794 :
1795 :	gage	6175	my @archive_courseIDs = $r->param("archive_courseIDs");
1796 :			@archive_courseIDs = () unless @archive_courseIDs;
1797 :	gage	3528	my @errors;
1798 :	gage	6175	foreach my $archive_courseID (@archive_courseIDs) {
1799 :			if ($archive_courseID eq "") {
1800 :			push @errors, "You must specify a course name.";
1801 :			} elsif ($archive_courseID eq $urlpath->arg("courseID")) {
1802 :			push @errors, "You cannot archive the course you are currently using.";
1803 :			}
1804 :	gage	3528	}
1805 :
1806 :	sh002i	5221	#my $ce2 = new WeBWorK::CourseEnvironment({
1807 :			# %WeBWorK::SeedCE,
1808 :			# courseName => $archive_courseID,
1809 :			#});
1810 :	gage	3528
1811 :			return @errors;
1812 :			}
1813 :
1814 :			sub archive_course_confirm {
1815 :			my ($self) = @_;
1816 :			my $r = $self->r;
1817 :			my $ce = $r->ce;
1818 :			#my $db = $r->db;
1819 :			#my $authz = $r->authz;
1820 :			#my $urlpath = $r->urlpath;
1821 :
1822 :			print CGI::h2("archive Course");
1823 :
1824 :	gage	4136	my $delete_course_flag = $r->param("delete_course") \|\| "";
1825 :	sh002i	4357
1826 :	gage	6175	my @archive_courseIDs = $r->param("archive_courseIDs");
1827 :			@archive_courseIDs = () unless @archive_courseIDs;
1828 :	gage	6176	my $archive_courseID = $r->param("archive_courseID");
1829 :			$archive_courseID = $archive_courseIDs[0] unless $archive_courseID;
1830 :	gage	6175
1831 :
1832 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
1833 :			%WeBWorK::SeedCE,
1834 :			courseName => $archive_courseID,
1835 :			});
1836 :	gage	5978
1837 :	gage	3528
1838 :	gage	5985	my ($tables_ok,$dbStatus);
1839 :	gage	5986	#############################################################################
1840 :			# Check database
1841 :			#############################################################################
1842 :	gage	5973	my %missing_fields;
1843 :	gage	4136	if ($ce2->{dbLayoutName} ) {
1844 :	gage	5978	my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
1845 :	gage	5985	($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID);
1846 :			if ($r->param("upgrade_course_tables")) {
1847 :			my @schema_table_names = keys %$dbStatus; # update tables missing from database;
1848 :			my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names;
1849 :			my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names;
1850 :			my $msg = $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create]);
1851 :			foreach my $table_name (@tables_to_alter) {
1852 :			$msg .= $CIchecker->updateTableFields($archive_courseID, $table_name);
1853 :			}
1854 :	gage	5978	print CGI::p({-style=>'color:green; font-weight:bold'}, $msg);
1855 :			}
1856 :	gage	6004	if ($r->param("upgrade_course_tables") ) {
1857 :
1858 :			$CIchecker -> updateCourseDirectories(); # needs more error messages
1859 :
1860 :
1861 :
1862 :			}
1863 :	gage	5985	($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID);
1864 :
1865 :
1866 :			# print db status
1867 :
1868 :			my %msg =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"),
1869 :			WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"),
1870 :			WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," Table is ok "),
1871 :			WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "),
1872 :			);
1873 :			my %msg2 =( WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => CGI::span({style=>"color:red"}," missing in database"),
1874 :			WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => CGI::span({style=>"color:red"}," missing in schema"),
1875 :			WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => CGI::span({style=>"color:green"}," is ok "),
1876 :			WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "),
1877 :			);
1878 :			my $all_tables_ok=1;
1879 :			my $extra_database_tables=0;
1880 :			my $extra_database_fields=0;
1881 :			my $str=CGI::h4("Report on database structure for course $archive_courseID:").CGI::br();
1882 :			foreach my $table (sort keys %$dbStatus) {
1883 :			my $table_status = $dbStatus->{$table}->[0];
1884 :			$str .= CGI::b($table) . $msg{ $table_status } . CGI::br();
1885 :
1886 :			CASE: {
1887 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B
1888 :			&& do{ last CASE;
1889 :			};
1890 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
1891 :			&& do{
1892 :			$all_tables_ok = 0; last CASE;
1893 :			};
1894 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
1895 :			&& do{
1896 :			$extra_database_tables = 1; last CASE;
1897 :			};
1898 :			$table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B
1899 :			&& do{
1900 :			my %fieldInfo = %{ $dbStatus->{$table}->[1] };
1901 :			foreach my $key (keys %fieldInfo) {
1902 :			my $field_status = $fieldInfo{$key}->[0];
1903 :			CASE2: {
1904 :			$field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
1905 :			&& do{
1906 :			$extra_database_fields = 1; last CASE2;
1907 :			};
1908 :			$field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
1909 :			&& do{
1910 :			$all_tables_ok=0; last CASE2;
1911 :			};
1912 :			}
1913 :			$str .= CGI::br()."\n  Field $key => ". $msg2{$field_status };
1914 :			}
1915 :			};
1916 :			}
1917 :			$str.=CGI::br();
1918 :
1919 :	gage	5978	}
1920 :	gage	5986	#############################################################################
1921 :			# Report on databases
1922 :			#############################################################################
1923 :
1924 :	gage	5978	print CGI::p($str);
1925 :	gage	5985	if ($extra_database_tables) {
1926 :			print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
1927 :			They can only be removed manually from the database.");
1928 :			}
1929 :			if ($extra_database_fields) {
1930 :			print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields which are not defined in the schema for at least one table.
1931 :			They can only be removed manually from the database.");
1932 :			}
1933 :			if ($all_tables_ok) {
1934 :			print CGI::p({-style=>'color:green; font-weight:bold'},"Course $archive_courseID database is in order");
1935 :	gage	5973	print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ".
1936 :	gage	5985	CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag;
1937 :	gage	5973	} else {
1938 :	gage	5985	print CGI::p({-style=>'color:red; font-weight:bold'}, "There are tables or fields missing from the
1939 :			database. The database
1940 :			must be upgraded before archiving this course."
1941 :			);
1942 :	gage	5973	}
1943 :	gage	5986	#############################################################################
1944 :			# Check directories
1945 :			#############################################################################
1946 :
1947 :
1948 :			my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
1949 :			my $style = ($directories_ok)?"color:green" : "color:red";
1950 :			print CGI::h2("Directory structure"), CGI::p($str2),
1951 :			($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
1952 :			CGI::p({style=>$style},"Directory structure is missing directories
1953 :			or the webserver lacks sufficient privileges.");
1954 :
1955 :
1956 :
1957 :
1958 :			#############################################################################
1959 :			# Print form for choosing next action.
1960 :			#############################################################################
1961 :
1962 :	gage	5973	print CGI::start_form(-method=>"POST", -action=>$r->uri);
1963 :			print $self->hidden_authen_fields;
1964 :			print $self->hidden_fields("subDisplay");
1965 :	gage	6175	print $self->hidden_fields(qw/delete_course/);
1966 :			print CGI::hidden('archive_courseID', $archive_courseID);
1967 :			print CGI::hidden('archive_courseIDs',@archive_courseIDs);
1968 :	gage	5973	# grab some values we'll need
1969 :			my $course_dir = $ce2->{courseDirs}{root};
1970 :			my $archive_path = $ce2->{webworkDirs}{courses} . "/$archive_courseID.tar.gz";
1971 :			# fail if the source course does not exist
1972 :			unless (-e $course_dir) {
1973 :			print CGI::p( "$archive_courseID: The directory for the course not found.");
1974 :			}
1975 :
1976 :	gage	5986	if ($all_tables_ok && $directories_ok ) { # no missing fields
1977 :	gage	5985	# Warn about overwriting an existing archive
1978 :			if (-e $archive_path and -w $archive_path) {
1979 :			print CGI::p({-style=>'color:red; font-weight:bold'},"The course '$archive_courseID' has already been archived at '$archive_path'.
1980 :			This earlier archive will be erased. This cannot be undone.");
1981 :			}
1982 :			# archive execute button
1983 :	gage	5973	print CGI::p({style=>"text-align: center"},
1984 :	gage	6175	CGI::submit(-name=>"decline_archive_course", -value=>"Stop archiving"),
1985 :	gage	5973	" ",
1986 :	gage	6175	(@archive_courseIDs)? CGI::submit(-name=>"archive_course", -value=>"Skip archiving this course")." ":'',
1987 :	gage	5973	CGI::submit(-name=>"confirm_archive_course", -value=>"archive") ,
1988 :			);
1989 :	gage	5986	} elsif( $directories_ok) {
1990 :	gage	5978	print CGI::p({style=>"text-align: center"},
1991 :	gage	5985	CGI::submit(-name => "decline_archive_course", -value => "Don't archive"),
1992 :	gage	5973	" ",
1993 :			CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"),
1994 :			);
1995 :	gage	5986	} else {
1996 :			print CGI::p({style=>"text-align: center"},
1997 :	gage	6004	CGI::br(),
1998 :			"Directory structure needs to be repaired manually before archiving.",CGI::br(),
1999 :			CGI::submit(-name => "decline_archive_course", -value => "Don't archive"),
2000 :			CGI::submit(-name => "upgrade_course_tables", -value => "Attempt to upgrade directories"),
2001 :	gage	5986	);
2002 :
2003 :			}
2004 :	gage	5973	print CGI::end_form();
2005 :			} else {
2006 :			print CGI::p({-style=>'color:red; font-weight:bold'},"Unable to find database layout for $archive_courseID");
2007 :	gage	3528	}
2008 :			}
2009 :
2010 :			sub do_archive_course {
2011 :			my ($self) = @_;
2012 :			my $r = $self->r;
2013 :			my $ce = $r->ce;
2014 :	gage	4136	my $db = $r->db;
2015 :	gage	3528	#my $authz = $r->authz;
2016 :			#my $urlpath = $r->urlpath;
2017 :
2018 :	gage	6175
2019 :	gage	3528	my $archive_courseID = $r->param("archive_courseID") \|\| "";
2020 :	gage	4136	my $delete_course_flag = $r->param("delete_course") \|\| "";
2021 :	gage	6175	my @archive_courseIDs = $r->param("archive_courseIDs");
2022 :			@archive_courseIDs = () unless @archive_courseIDs;
2023 :
2024 :	sh002i	5221	my $ce2 = new WeBWorK::CourseEnvironment({
2025 :			%WeBWorK::SeedCE,
2026 :			courseName => $archive_courseID,
2027 :			});
2028 :	gage	3528
2029 :	sh002i	4357	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
2030 :			# below this line, we would grab values from getopt and put them in this hash
2031 :			# but for now the hash can remain empty
2032 :	gage	3528	my %dbOptions;
2033 :
2034 :			eval {
2035 :			archiveCourse(
2036 :			courseID => $archive_courseID,
2037 :			ce => $ce2,
2038 :			dbOptions => \%dbOptions,
2039 :			);
2040 :			};
2041 :
2042 :			if ($@) {
2043 :			my $error = $@;
2044 :			print CGI::div({class=>"ResultsWithError"},
2045 :			CGI::p("An error occured while archiving the course $archive_courseID:"),
2046 :			CGI::tt(CGI::escapeHTML($error)),
2047 :			);
2048 :			} else {
2049 :			print CGI::div({class=>"ResultsWithoutError"},
2050 :			CGI::p("Successfully archived the course $archive_courseID"),
2051 :			);
2052 :			writeLog($ce, "hosted_courses", join("\t",
2053 :			"\tarchived",
2054 :			"",
2055 :			"",
2056 :			$archive_courseID,
2057 :			));
2058 :	gage	4136
2059 :			if ($delete_course_flag) {
2060 :			eval {
2061 :			deleteCourse(
2062 :			courseID => $archive_courseID,
2063 :			ce => $ce2,
2064 :			dbOptions => \%dbOptions,
2065 :			);
2066 :			};
2067 :
2068 :			if ($@) {
2069 :			my $error = $@;
2070 :			print CGI::div({class=>"ResultsWithError"},
2071 :			CGI::p("An error occured while deleting the course $archive_courseID:"),
2072 :			CGI::tt(CGI::escapeHTML($error)),
2073 :			);
2074 :			} else {
2075 :			# mark the contact person in the admin course as dropped.
2076 :			# find the contact person for the course by searching the admin classlist.
2077 :			my @contacts = grep /_$archive_courseID$/, $db->listUsers;
2078 :	sh002i	4311	if (@contacts) {
2079 :			die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1;
2080 :			#warn "contacts", join(" ", @contacts);
2081 :			#my $composite_id = "${add_initial_userID}_${add_courseID}";
2082 :			my $composite_id = $contacts[0];
2083 :
2084 :			# mark the contact person as dropped.
2085 :			my $User = $db->getUser($composite_id);
2086 :			my $status_name = 'Drop';
2087 :			my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
2088 :			$User->status($status_value);
2089 :			$db->putUser($User);
2090 :			}
2091 :	gage	4136
2092 :			print CGI::div({class=>"ResultsWithoutError"},
2093 :			CGI::p("Successfully deleted the course $archive_courseID."),
2094 :			);
2095 :			}
2096 :
2097 :
2098 :			}
2099 :	gage	6176	shift @archive_courseIDs; # remove the course which has just been archived.
2100 :	gage	6175	if (@archive_courseIDs) {
2101 :			print CGI::start_form(-method=>"POST", -action=>$r->uri);
2102 :			print $self->hidden_authen_fields;
2103 :			print $self->hidden_fields("subDisplay");
2104 :			print $self->hidden_fields(qw/delete_course/);
2105 :
2106 :			print CGI::hidden('archive_courseIDs',@archive_courseIDs);
2107 :			print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "Stop archiving courses"),
2108 :			CGI::submit("archive_course", "archive next course")
2109 :			);
2110 :			print CGI::end_form();
2111 :			} else {
2112 :			print CGI::start_form(-method=>"POST", -action=>$r->uri);
2113 :			print $self->hidden_authen_fields;
2114 :			print $self->hidden_fields("subDisplay");
2115 :			print CGI::hidden("archive_courseID",$archive_courseID);
2116 :			print CGI::p( CGI::submit("decline_archive_course", "OK") );
2117 :			print CGI::end_form();
2118 :			}
2119 :	gage	3528	}
2120 :			}
2121 :	sh002i	5207
2122 :	gage	4129	##########################################################################
2123 :	sh002i	5207
2124 :	gage	4129	sub unarchive_course_form {
2125 :			my ($self) = @_;
2126 :			my $r = $self->r;
2127 :			my $ce = $r->ce;
2128 :			#my $db = $r->db;
2129 :			#my $authz = $r->authz;
2130 :			#my $urlpath = $r->urlpath;
2131 :
2132 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2133 :
2134 :			# First find courses which have been archived.
2135 :			my @courseIDs = listArchivedCourses($ce);
2136 :			@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
2137 :
2138 :			my %courseLabels; # records... heh.
2139 :			foreach my $courseID (@courseIDs) {
2140 :			$courseLabels{$courseID} = $courseID;
2141 :			}
2142 :
2143 :	sh002i	5207	print CGI::h2("Unarchive Course");
2144 :	gage	4129
2145 :	sh002i	5207	print CGI::p(
2146 :			"Restores a course from a gzipped tar archive (.tar.gz). After
2147 :			unarchiving, the course database is restored from a subdirectory of the
2148 :			course's DATA directory. Currently the archive facility is only
2149 :			available for mysql databases. It depends on the mysqldump application."
2150 :			);
2151 :
2152 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
2153 :	gage	4129	print $self->hidden_authen_fields;
2154 :			print $self->hidden_fields("subDisplay");
2155 :
2156 :			print CGI::p("Select a course to unarchive.");
2157 :
2158 :			print CGI::table({class=>"FormLayout"},
2159 :	gage	4280	CGI::Tr({},
2160 :	gage	4129	CGI::th({class=>"LeftHeader"}, "Course Name:"),
2161 :			CGI::td(
2162 :			CGI::scrolling_list(
2163 :			-name => "unarchive_courseID",
2164 :			-values => \@courseIDs,
2165 :			-default => $unarchive_courseID,
2166 :			-size => 10,
2167 :			-multiple => 0,
2168 :			-labels => \%courseLabels,
2169 :			),
2170 :			),
2171 :			),
2172 :	gage	5028
2173 :			CGI::Tr({},
2174 :			CGI::th({class=>"LeftHeader"}, CGI::checkbox(-name => "create_newCourseID",-default=>'',-value=>1, -label=>'New Name:')),
2175 :			CGI::td(CGI::textfield(-name=>"new_courseID", -value=>'', -size=>25)),
2176 :			),
2177 :	gage	4129	);
2178 :
2179 :	gage	4244	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course"));
2180 :	gage	4129
2181 :			print CGI::end_form();
2182 :			}
2183 :
2184 :			sub unarchive_course_validate {
2185 :			my ($self) = @_;
2186 :			my $r = $self->r;
2187 :			my $ce = $r->ce;
2188 :			#my $db = $r->db;
2189 :			#my $authz = $r->authz;
2190 :			my $urlpath = $r->urlpath;
2191 :
2192 :	gage	5028	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2193 :			my $create_newCourseID = $r->param("create_newCourseID") \|\| "";
2194 :			my $new_courseID = $r->param("new_courseID") \|\| "";
2195 :	gage	4129	my @errors;
2196 :	gage	5028	#by default we use the archive name for the course
2197 :			my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//;
2198 :	gage	4129
2199 :	gage	5028	if ( $create_newCourseID) {
2200 :			$courseID = $new_courseID;
2201 :			}
2202 :			debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID ");
2203 :
2204 :			if ($courseID eq "") {
2205 :	gage	4129	push @errors, "You must specify a course name.";
2206 :	gage	5028	} elsif ( -d $ce->{webworkDirs}->{courses}."/$courseID" ) {
2207 :	gage	4129	#Check that a directory for this course doesn't already exist
2208 :	gage	5028	push @errors, "A directory already exists with the name $courseID.
2209 :	gage	4129	You must first delete this existing course before you can unarchive.";
2210 :			}
2211 :
2212 :
2213 :			return @errors;
2214 :			}
2215 :
2216 :			sub unarchive_course_confirm {
2217 :			my ($self) = @_;
2218 :			my $r = $self->r;
2219 :			my $ce = $r->ce;
2220 :			#my $db = $r->db;
2221 :			#my $authz = $r->authz;
2222 :			#my $urlpath = $r->urlpath;
2223 :
2224 :			print CGI::h2("Unarchive Course");
2225 :
2226 :	gage	5028	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2227 :			my $create_newCourseID = $r->param("create_newCourseID") \|\| "";
2228 :			my $new_courseID = $r->param("new_courseID") \|\| "";
2229 :
2230 :			my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//;
2231 :	gage	4129
2232 :	gage	5028	if ( $create_newCourseID) {
2233 :			$courseID = $new_courseID;
2234 :			}
2235 :	gage	4129
2236 :	gage	5028	debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID ");
2237 :	gage	4129
2238 :	gage	4244	print CGI::start_form(-method=>"POST", -action=>$r->uri);
2239 :	gage	4129	print CGI::p($unarchive_courseID," to course ",
2240 :	gage	5028	CGI::input({-name=>'new_courseID', -value=>$courseID})
2241 :	gage	4129	);
2242 :
2243 :			print $self->hidden_authen_fields;
2244 :			print $self->hidden_fields("subDisplay");
2245 :	gage	5028	print $self->hidden_fields(qw/unarchive_courseID create_newCourseID/);
2246 :	gage	4129
2247 :			print CGI::p({style=>"text-align: center"},
2248 :	gage	4244	CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"),
2249 :	gage	4129	" ",
2250 :	gage	4244	CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"),
2251 :	gage	4129	);
2252 :
2253 :			print CGI::end_form();
2254 :			}
2255 :
2256 :			sub do_unarchive_course {
2257 :			my ($self) = @_;
2258 :			my $r = $self->r;
2259 :			my $ce = $r->ce;
2260 :			#my $db = $r->db;
2261 :			#my $authz = $r->authz;
2262 :			my $urlpath = $r->urlpath;
2263 :			my $new_courseID = $r->param("new_courseID") \|\| "";
2264 :			my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
2265 :
2266 :	gage	5028	my $old_courseID = $unarchive_courseID; $old_courseID =~ s/.tar.gz//;
2267 :	gage	4129
2268 :	sh002i	5207	#eval {
2269 :	gage	4129	unarchiveCourse(
2270 :	gage	5028	newCourseID => $new_courseID,
2271 :			oldCourseID => $old_courseID,
2272 :	gage	4129	archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID",
2273 :	sh002i	5207	ce => $ce,
2274 :	gage	4129	);
2275 :	sh002i	5207	#};
2276 :	gage	4129
2277 :			if ($@) {
2278 :			my $error = $@;
2279 :			print CGI::div({class=>"ResultsWithError"},
2280 :			CGI::p("An error occured while archiving the course $unarchive_courseID:"),
2281 :			CGI::tt(CGI::escapeHTML($error)),
2282 :			);
2283 :			} else {
2284 :			print CGI::div({class=>"ResultsWithoutError"},
2285 :			CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"),
2286 :			);
2287 :			writeLog($ce, "hosted_courses", join("\t",
2288 :			"\tunarchived",
2289 :			"",
2290 :			"",
2291 :			"$unarchive_courseID to $new_courseID",
2292 :			));
2293 :
2294 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
2295 :			courseID => $new_courseID);
2296 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
2297 :			print CGI::div({style=>"text-align: center"},
2298 :			CGI::a({href=>$newCourseURL}, "Log into $new_courseID"),
2299 :			);
2300 :	gage	6175
2301 :			print CGI::start_form(-method=>"POST", -action=>$r->uri);
2302 :			print $self->hidden_authen_fields;
2303 :			print $self->hidden_fields("subDisplay");
2304 :			print CGI::hidden("unarchive_courseID",$unarchive_courseID);
2305 :			print CGI::p( CGI::submit("decline_unarchive_course", "unarchive next course") );
2306 :			print CGI::end_form();
2307 :
2308 :	gage	4129	}
2309 :			}
2310 :
2311 :	gage	3528	################################################################################
2312 :	glarose	4910	## location management routines; added by DG [Danny Ginn] 20070215
2313 :			## revised by glarose
2314 :
2315 :			sub manage_location_form {
2316 :			my ($self) = @_;
2317 :			my $r = $self->r;
2318 :			my $ce = $r->ce;
2319 :			my $db = $r->db;
2320 :			#my $authz = $r->authz;
2321 :			my $urlpath = $r->urlpath;
2322 :
2323 :			# get a list of all existing locations
2324 :			my @locations = sort {lc($a->location_id) cmp lc($b->location_id)}
2325 :			$db->getAllLocations();
2326 :			my %locAddr = map {$_->location_id => [ $db->listLocationAddresses($_->location_id) ]} @locations;
2327 :
2328 :			my @locationIDs = map { $_->location_id } @locations;
2329 :
2330 :			print CGI::h2("Manage Locations");
2331 :
2332 :			print CGI::p({},CGI::strong("Currently defined locations are listed below."));
2333 :
2334 :			print CGI::start_form(-method=>"POST", -action=>$r->uri);
2335 :			print $self->hidden_authen_fields;
2336 :			print $self->hidden_fields("subDisplay");
2337 :
2338 :			# get a list of radio buttons to select an action
2339 :			my @actionRadios =
2340 :			CGI::radio_group(-name => "manage_location_action",
2341 :			-values => ["edit_location_form",
2342 :			"add_location_handler",
2343 :			"delete_location_handler"],
2344 :			-labels => { edit_location_form => "",
2345 :			add_location_handler => "",
2346 :			delete_location_handler => "", },
2347 :			-default => $r->param("manage_location_action") ? $r->param("manage_location_action") : 'none');
2348 :
2349 :			print CGI::start_table({});
2350 :			print CGI::Tr({}, CGI::th({-colspan=>4,-align=>"left"},
2351 :			"Select an action to perform:"));
2352 :
2353 :			# edit action
2354 :			print CGI::Tr({},
2355 :			CGI::td({},[ $actionRadios[0], "Edit Location:" ]),
2356 :			CGI::td({-colspan=>2, -align=>"left"},
2357 :			CGI::div({-style=>"width:25%;"},
2358 :			CGI::popup_menu(-name=>"edit_location",
2359 :			-values=>[@locationIDs]))) );
2360 :			# create action
2361 :			print CGI::Tr({},
2362 :			CGI::td({-align=>"left"},[ $actionRadios[1],
2363 :			"Create Location:" ]),
2364 :			CGI::td({-colspan=>2},
2365 :			"Location name: " .
2366 :			CGI::textfield(-name=>"new_location_name",
2367 :			-size=>"10",
2368 :			-default=>$r->param("new_location_name")?$r->param("new_location_name"):'')));
2369 :			print CGI::Tr({valign=>'top'},
2370 :			CGI::td({}, [" ", "Location description:"]),
2371 :			CGI::td({-colspan=>2},
2372 :			CGI::textfield(-name=>"new_location_description",
2373 :			-size=>"50",
2374 :			-default=>$r->param("new_location_description")?$r->param("new_location_description"):'')) );
2375 :			print CGI::Tr({}, CGI::td({}," "),
2376 :			CGI::td({-colspan=>3}, "Addresses for new location " .
2377 :			"(enter one per line, as single IP addresses " .
2378 :			"(e.g., 192.168.1.101), address masks (e.g., " .
2379 :			"192.168.1.0/24), or IP ranges (e.g., " .
2380 :			"192.168.1.101-192.168.1.150)):"));
2381 :			print CGI::Tr({}, CGI::td({}, " "),
2382 :			CGI::td({-colspan=>3},
2383 :			CGI::textarea({-name=>"new_location_addresses",
2384 :			-rows=>5, -columns=>28,
2385 :			-default=>$r->param("new_location_addresses")?$r->param("new_location_addresses"):''})));
2386 :
2387 :			# delete action
2388 :			print CGI::Tr({},
2389 :			CGI::td({-colspan=>4},
2390 :			CGI::div({-class=>"ResultsWithError"},
2391 :			CGI::em({}, "Deletion deletes all location " .
2392 :			"data and related addresses, and is" .
2393 :
2394 :			" not undoable!"))));
2395 :			print CGI::Tr({},
2396 :			CGI::td({},
2397 :			[ $actionRadios[2],
2398 :			CGI::div({-class=>"ResultsWithError"},
2399 :			"Delete location:") ]),
2400 :			CGI::td({-colspan=>2},
2401 :			CGI::popup_menu(-name=>"delete_location",
2402 :	glarose	4918	-values=>["",
2403 :	glarose	4917	"selected_locations",
2404 :			@locationIDs],
2405 :	glarose	4918	-labels=>{selected_locations => "locations selected below",
2406 :			"" => "no location"}) .
2407 :	glarose	4910	CGI::span({-style=>"color:#C33;"}, " Confirm: ") .
2408 :			CGI::checkbox({-name=>"delete_confirm",
2409 :			-value=>"true",
2410 :			-label=>""}) ) );
2411 :			print CGI::end_table();
2412 :
2413 :			print CGI::p({}, CGI::submit(-name=>"manage_locations", -value=>"Take Action!"));
2414 :
2415 :			# existing location table
2416 :			# FIXME: the styles for this table should be off in a stylesheet
2417 :			# somewhere
2418 :			print CGI::start_div({align=>"center"}),
2419 :			CGI::start_table({border=>1, cellpadding=>2});
2420 :			print CGI::Tr({style=>"background-color:#e0e0e0;font-size:92%", align=>"left"},
2421 :	glarose	4917	CGI::th({}, ["Select", "Location", "Description",
2422 :			"Addresses"]));
2423 :	glarose	4910	foreach my $loc ( @locations ) {
2424 :	glarose	4917	my $editAddr = $self->systemLink($urlpath, params=>{subDisplay=>"manage_locations", manage_location_action=>"edit_location_form", edit_location=>$loc->location_id});
2425 :	glarose	4910	print CGI::Tr({valign=>'top',style=>"background-color:#eeeeee;"},
2426 :			CGI::td({style=>'font-size:85%;'},
2427 :	glarose	4917	[ CGI::checkbox(-name=>"delete_selected",
2428 :			-value=>$loc->location_id,
2429 :			-label=>''),
2430 :			CGI::a({href=>$editAddr}, $loc->location_id),
2431 :	glarose	4910	$loc->description,
2432 :			join(', ', @{$locAddr{$loc->location_id}}) ]));
2433 :			}
2434 :			print CGI::end_table(), CGI::end_div();
2435 :	glarose	4917	print CGI::end_form();
2436 :	glarose	4910
2437 :	glarose	4917
2438 :	glarose	4910	}
2439 :
2440 :			sub add_location_handler {
2441 :			my $self = shift();
2442 :			my $r = $self->r;
2443 :			my $db = $r->db;
2444 :
2445 :			# the location data we're to add
2446 :			my $locationID = $r->param("new_location_name");
2447 :			my $locationDescr = $r->param("new_location_description");
2448 :			my $locationAddr = $r->param("new_location_addresses");
2449 :			# break the addresses up
2450 :			$locationAddr =~ s/\s-\s/-/g;
2451 :			$locationAddr =~ s/\s\/\s/\//g;
2452 :			my @addresses = split(/\s+/, $locationAddr);
2453 :
2454 :			# sanity checks
2455 :			my $badAddr = '';
2456 :			foreach my $addr ( @addresses ) {
2457 :			unless ( new Net::IP($addr) ) {
2458 :			$badAddr .= "$addr, ";
2459 :			$locationAddr =~ s/$addr\n//s;
2460 :			}
2461 :			}
2462 :			$badAddr =~ s/, $//;
2463 :
2464 :			# a check to be sure that the location addresses don't already
2465 :			# exist
2466 :			my $badLocAddr;
2467 :			if ( ! $badAddr && $locationID ) {
2468 :			if ( $db->countLocationAddresses( $locationID ) ) {
2469 :			my @allLocAddr = $db->listLocationAddresses($locationID);
2470 :			foreach my $addr ( @addresses ) {
2471 :			$badLocAddr .= "$addr, "
2472 :			if ( grep {/^$addr$/} @allLocAddr );
2473 :			}
2474 :			$badLocAddr =~ s/, $//;
2475 :			}
2476 :			}
2477 :
2478 :			if ( ! @addresses \|\| ! $locationID \|\| ! $locationDescr ) {
2479 :			print CGI::div({-class=>"ResultsWithError"},
2480 :			"Missing required input data. Please check " .
2481 :			"that you have filled in all of the create " .
2482 :			"location fields and resubmit.");
2483 :			} elsif ( $badAddr ) {
2484 :			$r->param("new_location_addresses", $locationAddr);
2485 :			print CGI::div({-class=>"ResultsWithError"},
2486 :			"Address(es) $badAddr is(are) not in a " .
2487 :			"recognized form. Please check your " .
2488 :			"data entry and resubmit.");
2489 :			} elsif ( $db->existsLocation( $locationID ) ) {
2490 :			print CGI::div({-class=>"ResultsWithError"},
2491 :			"A location with the name $locationID " .
2492 :			"already exists in the database. Did " .
2493 :			"you mean to edit that location instead?");
2494 :			} elsif ( $badLocAddr ) {
2495 :			print CGI::div({-class=>"ResultsWithError"},
2496 :			"Address(es) $badLocAddr already exist " .
2497 :			"in the database. THIS SHOULD NOT HAPPEN! " .
2498 :			"Please double check the integrity of " .
2499 :			"the WeBWorK database before continuing.");
2500 :			} else {
2501 :			# add the location
2502 :			my $locationObj = $db->newLocation;
2503 :			$locationObj->location_id( $locationID );
2504 :			$locationObj->description( $locationDescr );
2505 :			$db->addLocation( $locationObj );
2506 :
2507 :			# and add the addresses
2508 :			foreach my $addr ( @addresses ) {
2509 :			my $locationAddress = $db->newLocationAddress;
2510 :			$locationAddress->location_id($locationID);
2511 :			$locationAddress->ip_mask($addr);
2512 :
2513 :			$db->addLocationAddress( $locationAddress );
2514 :			}
2515 :
2516 :			# we've added the location, so clear those param
2517 :			# entries
2518 :			$r->param('manage_location_action','none');
2519 :			$r->param('new_location_name','');
2520 :			$r->param('new_location_description','');
2521 :			$r->param('new_location_addresses','');
2522 :
2523 :			print CGI::div({-class=>"ResultsWithoutError"},
2524 :			"Location $locationID has been created, " .
2525 :			"with addresses " . join(', ', @addresses) .
2526 :			".");
2527 :			}
2528 :
2529 :			$self->manage_location_form;
2530 :			}
2531 :
2532 :			sub delete_location_handler {
2533 :			my $self = shift;
2534 :			my $r = $self->r;
2535 :			my $db = $r->db;
2536 :
2537 :			# what location are we deleting?
2538 :			my $locationID = $r->param("delete_location");
2539 :	glarose	4917	# check for selected deletions if appropriate
2540 :			my @delLocations = ( $locationID );
2541 :			if ( $locationID eq 'selected_locations' ) {
2542 :			@delLocations = $r->param("delete_selected");
2543 :			$locationID = @delLocations;
2544 :			}
2545 :	glarose	4910	# are we sure?
2546 :			my $confirm = $r->param("delete_confirm");
2547 :
2548 :	glarose	4917	my $badID;
2549 :	glarose	4910	if ( ! $locationID ) {
2550 :			print CGI::div({-class=>"ResultsWithError"},
2551 :			"Please provide a location name " .
2552 :			"to delete.");
2553 :
2554 :	glarose	4917	} elsif ( $badID = $self->existsLocations_helper( @delLocations ) ) {
2555 :	glarose	4910	print CGI::div({-class=>"ResultsWithError"},
2556 :	glarose	4917	"No location with name $badID " .
2557 :	glarose	4910	"exists in the database.");
2558 :
2559 :			} elsif ( ! $confirm \|\| $confirm ne 'true' ) {
2560 :			print CGI::div({-class=>"ResultsWithError"},
2561 :			"Location deletion requires confirmation.");
2562 :			} else {
2563 :	glarose	4917	foreach ( @delLocations ) {
2564 :			$db->deleteLocation( $_ );
2565 :			}
2566 :	glarose	4910	print CGI::div({-class=>"ResultsWithoutError"},
2567 :	glarose	4917	"Location" . (@delLocations > 1 ? 's ' : ' ') .
2568 :			join(', ', @delLocations) .
2569 :			(@delLocations > 1 ? ' have ' : ' has ' ) .
2570 :			'been deleted.');
2571 :	glarose	4910	$r->param('manage_location_action','none');
2572 :			$r->param('delete_location','');
2573 :			}
2574 :			$self->manage_location_form;
2575 :			}
2576 :	glarose	4917	sub existsLocations_helper {
2577 :			my ($self, @locations) = @_;
2578 :			my $db = $self->r->db;
2579 :			foreach ( @locations ) {
2580 :			return $_ if ( ! $db->existsLocation($_) );
2581 :			}
2582 :			return 0;
2583 :			}
2584 :	glarose	4910
2585 :			sub edit_location_form {
2586 :			my $self = shift;
2587 :			my $r = $self->r;
2588 :			my $db = $r->db;
2589 :
2590 :			my $locationID = $r->param("edit_location");
2591 :			if ( $db->existsLocation( $locationID ) ) {
2592 :			my $location = $db->getLocation($locationID);
2593 :			# this doesn't give that nice a sort for IP addresses,
2594 :			# b/c there's the problem with 192.168.1.168 sorting
2595 :			# ahead of 192.168.1.2. we could do better if we
2596 :			# either invoked Net::IP in the sort routine, or if
2597 :			# we insisted on dealing only with IPv4. rather than
2598 :			# deal with either of those, we'll leave this for now
2599 :			my @locAddresses = sort { $a cmp $b }
2600 :			$db->listLocationAddresses($locationID);
2601 :
2602 :			print CGI::h2("Editing location ", $locationID);
2603 :
2604 :			print CGI::p({},"Edit the current value of the location ",
2605 :			"description, if desired, then add and select ",
2606 :			"addresses to delete, and then click the ",
2607 :			"\"Take Action\" button to make all of your ",
2608 :			"changes. Or, click \"Manage Locations\" ",
2609 :			"above to make no changes and return to the ",
2610 :			"Manage Locations page.");
2611 :
2612 :			print CGI::start_form(-method=>"POST",
2613 :			-action=>$r->uri);
2614 :			print $self->hidden_authen_fields;
2615 :			print $self->hidden_fields("subDisplay");
2616 :			print CGI::hidden(-name=>'edit_location',
2617 :			-default=>$locationID);
2618 :			print CGI::hidden(-name=>'manage_location_action',
2619 :			-default=>'edit_location_handler');
2620 :
2621 :			print CGI::start_table();
2622 :			print CGI::Tr({-valign=>'top'},
2623 :			CGI::td({-colspan=>3},
2624 :			"Location description: ", CGI::br(),
2625 :			CGI::textfield(-name=>"location_description",
2626 :			-size=>"50",
2627 :			-default=>$location->description)));
2628 :			print CGI::Tr({-valign=>'top'},
2629 :			CGI::td({-width=>"50%"},
2630 :			"Addresses to add to the location " .
2631 :			"(enter one per line, as single IP addresses " .
2632 :			"(e.g., 192.168.1.101), address masks " .
2633 :			"(e.g., 192.168.1.0/24), or IP ranges " .
2634 :			"(e.g., 192.168.1.101-192.168.1.150)):" .
2635 :			CGI::br() .
2636 :			CGI::textarea({-name=>"new_location_addresses",
2637 :			-rows=>5, -columns=>28})),
2638 :			CGI::td({}, " "),
2639 :			CGI::td({-width=>"50%"},
2640 :			"Existing addresses for the location are " .
2641 :			"given in the scrolling list below. Select " .
2642 :			"addresses from the list to delete them:" .
2643 :			CGI::br() .
2644 :			CGI::scrolling_list(-name=>'delete_location_addresses',
2645 :			-values=>[@locAddresses],
2646 :			-size=>8,
2647 :			-multiple=>'multiple') .
2648 :			CGI::br() . "or: " .
2649 :			CGI::checkbox(-name=>'delete_all_addresses',
2650 :			-value=>'true',
2651 :			-label=>'Delete all existing addresses')
2652 :			));
2653 :
2654 :			print CGI::end_table();
2655 :
2656 :			print CGI::p({},CGI::submit(-value=>'Take Action!'));
2657 :
2658 :			} else {
2659 :			print CGI::div({-class=>"ResultsWithError"},
2660 :			"Location $locationID does not exist " .
2661 :			"in the WeBWorK database. Please check " .
2662 :			"your input (perhaps you need to reload " .
2663 :			"the location management page?).");
2664 :
2665 :			$self->manage_location_form;
2666 :			}
2667 :			}
2668 :
2669 :			sub edit_location_handler {
2670 :			my $self = shift;
2671 :			my $r = $self->r;
2672 :			my $db = $r->db;
2673 :
2674 :			my $locationID = $r->param("edit_location");
2675 :			my $locationDesc = $r->param("location_description");
2676 :			my $addAddresses = $r->param("new_location_addresses");
2677 :			my @delAddresses = $r->param("delete_location_addresses");
2678 :			my $deleteAll = $r->param("delete_all_addresses");
2679 :
2680 :			# gut check
2681 :			if ( ! $locationID ) {
2682 :			print CGI::div({-class=>"ResultsWithError"},
2683 :			"No location specified to edit?! " .
2684 :			"Please check your input data.");
2685 :			$self->manage_location_form;
2686 :
2687 :			} elsif ( ! $db->existsLocation( $locationID ) ) {
2688 :			print CGI::div({-class=>"ResultsWithError"},
2689 :			"Location $locationID does not exist " .
2690 :			"in the WeBWorK database. Please check " .
2691 :			"your input (perhaps you need to reload " .
2692 :			"the location management page?).");
2693 :			$self->manage_location_form;
2694 :			} else {
2695 :			my $location = $db->getLocation($locationID);
2696 :
2697 :			# get the current location addresses. if we're deleting
2698 :			# all of the existing addresses, we don't use this list
2699 :			# to determine which addresses to add, however.
2700 :			my @currentAddr = $db->listLocationAddresses($locationID);
2701 :			my @compareAddr = ( ! $deleteAll \|\| $deleteAll ne 'true' )
2702 :			? @currentAddr : ();
2703 :
2704 :			my $doneMsg = '';
2705 :
2706 :			if ($locationDesc && $location->description ne $locationDesc) {
2707 :			$location->description($locationDesc);
2708 :			$db->putLocation($location);
2709 :			$doneMsg .= CGI::p({},"Updated location description.");
2710 :			}
2711 :			# get the actual addresses to add out of the text field
2712 :			$addAddresses =~ s/\s-\s/-/g;
2713 :			$addAddresses =~ s/\s\/\s/\//g;
2714 :			my @addAddresses = split(/\s+/, $addAddresses);
2715 :
2716 :			# make sure that we're adding and deleting only those
2717 :			# addresses that are not yet/currently in the location
2718 :			# addresses
2719 :			my @toAdd = (); my @noAdd = ();
2720 :			my @toDel = (); my @noDel = ();
2721 :			foreach my $addr ( @addAddresses ) {
2722 :			if (grep {/^$addr$/} @compareAddr) {push(@noAdd,$addr);}
2723 :			else { push(@toAdd, $addr); }
2724 :			}
2725 :			if ( $deleteAll && $deleteAll eq 'true' ) {
2726 :			@toDel = @currentAddr;
2727 :			} else {
2728 :			foreach my $addr ( @delAddresses ) {
2729 :			if (grep {/^$addr$/} @currentAddr) {
2730 :			push(@toDel,$addr);
2731 :			} else { push(@noDel, $addr); }
2732 :			}
2733 :			}
2734 :
2735 :			# and make sure that all of the addresses we're adding are
2736 :			# a sensible form
2737 :			my $badAddr = '';
2738 :			foreach my $addr ( @toAdd ) {
2739 :			unless ( new Net::IP($addr) ) {
2740 :			$badAddr .= "$addr, ";
2741 :			}
2742 :			}
2743 :			$badAddr =~ s/, $//;
2744 :
2745 :			# delete addresses first, because we allow deletion of
2746 :			# all existing addresses, then addition of addresses.
2747 :			# note that we don't allow deletion and then addition
2748 :			# of the same address normally, however; in that case
2749 :			# we'll end up just deleting the address.
2750 :			foreach ( @toDel ) {
2751 :			$db->deleteLocationAddress($locationID, $_);
2752 :			}
2753 :			foreach ( @toAdd ) {
2754 :			my $locAddr = $db->newLocationAddress;
2755 :			$locAddr->location_id($locationID);
2756 :			$locAddr->ip_mask($_);
2757 :
2758 :			$db->addLocationAddress($locAddr);
2759 :			}
2760 :
2761 :			my $addrMsg = '';
2762 :			$addrMsg .= "Deleted addresses " . join(', ', @toDel) .
2763 :			" from location." . CGI::br() if ( @toDel );
2764 :			$addrMsg .= "Added addresses " . join(', ', @toAdd) .
2765 :			" to location $locationID. " if ( @toAdd );
2766 :
2767 :			my $badMsg = '';
2768 :			$badMsg .= 'Address(es) ' . join(', ', @noAdd) .
2769 :			" in the add list is(are) already in the " .
2770 :			"location $locationID, and so were " .
2771 :			"skipped." . CGI::br() if ( @noAdd );
2772 :			$badMsg .= "Address(es) $badAddr is(are) not in a " .
2773 :			"recognized form. Please check your data " .
2774 :			"entry and try again." . CGI::br() if ( $badAddr );
2775 :			$badMsg .= 'Address(es) ' . join(', ', @noDel) .
2776 :			" in the delete list is(are) not in the " .
2777 :			"location $locationID, and so were " .
2778 :			"skipped." if ( @noDel );
2779 :
2780 :			print CGI::div({-class=>"ResultsWithError"}, $badMsg)
2781 :			if ( $badMsg );
2782 :			if ( $doneMsg \|\| $addrMsg ) {
2783 :			print CGI::div({-class=>"ResultsWithoutError"},
2784 :			CGI::p({}, $doneMsg, $addrMsg));
2785 :			} else {
2786 :			print CGI::div({-class=>"ResultsWithError"},
2787 :			"No valid changes submitted for ",
2788 :			"location $locationID.");
2789 :			}
2790 :
2791 :			$self->edit_location_form;
2792 :			}
2793 :			}
2794 :
2795 :			################################################################################
2796 :	gage	5664	# registration forms added by Mike Gage 5-5-2008
2797 :			################################################################################
2798 :
2799 :			our $registered_file_name = "registered_$main::VERSION";
2800 :	gage	5716
2801 :	gage	5664	sub display_registration_form {
2802 :	gage	5716	my $self = shift;
2803 :			my $ce = $self->r->ce;
2804 :			my $registeredQ = (-e ($ce->{courseDirs}->{root})."/$registered_file_name")?1:0;
2805 :			#my $registration_subDisplay = ( $self->{method_to_call} eq "registration_form") ? 1: 0;
2806 :			return 0 if $registeredQ or $self->r->param("register_site"); #otherwise return registration form
2807 :			return q!
2808 :			<center>
2809 :			<table class="messagebox" style="background-color:#FFFFCC;width:60%">
2810 :			<tr><td>
2811 :			!,
2812 :			CGI::p("If you are using your WeBWorK server for courses please help us out by registering your server."),
2813 :			CGI::p("We are often asked how many institutions are using WeBWorK and how many students are using
2814 :	gage	5776	WeBWorK Since WeBWorK is open source and can be freely downloaded from ".
2815 :	gage	5840	CGI::a({href=>'http://webwork.maa.org'},'http://webwork.maa.org' ). " and ".
2816 :			CGI::a({href=> 'http://www.openwebwork.org'},'http://www.openwebwork.org'). ", it is frequently difficult for us to give a reasonable answer to this
2817 :	gage	5716	question."),
2818 :			CGI::p("You can help by registering your current version of WeBWorK -- click the button, answer a few
2819 :			questions (the ones you can answer easily) and send the email. It takes less than two minutes. Thank you!. -- The WeBWorK Team"),
2820 :			q!
2821 :			</td>
2822 :			</tr>
2823 :			<tr><td align="center">
2824 :			!,
2825 :			CGI::a({href=>$self->systemLink($self->r->urlpath, params=>{subDisplay=>"registration"})}, "Register"),
2826 :			q!
2827 :			</td></tr>
2828 :			</table>
2829 :			</center>
2830 :			!;
2831 :
2832 :	gage	5664
2833 :
2834 :	gage	5716	}
2835 :	gage	5664
2836 :			sub registration_form {
2837 :	gage	5716	my $self = shift;
2838 :			my $ce = $self->r->ce;
2839 :
2840 :			print "<center>";
2841 :			print "\n",CGI::p({style=>"text-align: left; width:60%"},
2842 :			"\nPlease ",
2843 :			CGI::a({href=>'mailto:gage@math.rochester.edu?'
2844 :			.'subject=WeBWorK%20Server%20Registration'
2845 :			.'&body='
2846 :			.uri_escape("Thanks for registering your WeBWorK server. We'd appreciate if you would answer
2847 :			as many of these questions as you can conveniently. We need this data so we can better
2848 :			answer questions such as 'How many institutions have webwork servers?' and 'How many students
2849 :			use WeBWorK?'. Your email and contact information will be kept private. We will
2850 :			list your institution as one that uses WeBWorK unless you tell us to keep that private as well.
2851 :			\n\nThank you. \n\n--Mike Gage \n\n
2852 :			")
2853 :			.uri_escape("Server URL: ".$ce->{apache_root_url}." \n\n")
2854 :			.uri_escape("WeBWorK version: $main::VERSION \n\n")
2855 :			.uri_escape("Institution name (e.g. University of Rochester): \n\n")
2856 :			.uri_escape("Contact person name: \n\n")
2857 :			.uri_escape("Contact email: \n\n")
2858 :			.uri_escape("Approximate number of courses run each term: \n\n")
2859 :			.uri_escape("Approximate number of students using this server each term: \n\n")
2860 :			.uri_escape("Other institutions who use WeBWorK courses hosted on this server: \n\n")
2861 :			.uri_escape("Other comments: \n\n")
2862 :			},
2863 :			'click here'),
2864 :			q! to open your email application. There are a few questions, some of which have already
2865 :			been filled in for your installation. Fill in the other questions which you can answer easily and send
2866 :	gage	5776	the email to gage@math.rochester.edu
2867 :	gage	5716	!
2868 :			);
2869 :
2870 :
2871 :
2872 :			print "\n",CGI::p({style=>"text-align: left; width:60%"},q!Once you have emailed your registration information you can hide the "registration" banner
2873 :			for successive visits by clicking
2874 :	gage	5776	the button below. It writes an empty file (!.CGI::code('registered_versionNumber').q!) to the directory !.CGI::code('..../courses/admin')
2875 :			);
2876 :	gage	5716
2877 :			print "</center>";
2878 :			print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
2879 :			print $self->hidden_authen_fields;
2880 :			print $self->hidden_fields("subDisplay");
2881 :			print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"register_site", -label=>"Site has been registered"));
2882 :			print CGI::end_form();
2883 :	gage	5664	}
2884 :
2885 :
2886 :
2887 :			sub do_registration {
2888 :	gage	5716	my $self = shift;
2889 :			my $ce = $self->r->ce;
2890 :			my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name";
2891 :			# warn qq!`echo "info" >$registered_file_path`!;
2892 :			`echo "info" >$registered_file_path`;
2893 :
2894 :			print "\n<center>",CGI::p({style=>"text-align: left; width:60%"},q{Registration action completed. Thank you very much for registering WeBWorK!"});
2895 :
2896 :			print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
2897 :			print $self->hidden_authen_fields;
2898 :			print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"registration_completed", -label=>"Continue"));
2899 :			print CGI::end_form();
2900 :			print "</center>";
2901 :	gage	5664
2902 :			}
2903 :			################################################################################
2904 :	sh002i	1945	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9