Annotation of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

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

1 :	sh002i	1945	################################################################################
2 :			# WeBWorK Online Homework Delivery System
3 :			# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 :	sh002i	2384	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.20 2004/06/23 23:10:44 sh002i Exp $
5 :	sh002i	1945	#
6 :			# This program is free software; you can redistribute it and/or modify it under
7 :			# the terms of either: (a) the GNU General Public License as published by the
8 :			# Free Software Foundation; either version 2, or (at your option) any later
9 :			# version, or (b) the "Artistic License" which comes with this package.
10 :			#
11 :			# This program is distributed in the hope that it will be useful, but WITHOUT
12 :			# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :			# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :			# Artistic License for more details.
15 :			################################################################################
16 :
17 :			package WeBWorK::ContentGenerator::CourseAdmin;
18 :			use base qw(WeBWorK::ContentGenerator);
19 :
20 :			=head1 NAME
21 :
22 :			WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses.
23 :
24 :			=cut
25 :
26 :			use strict;
27 :			use warnings;
28 :			use CGI::Pretty qw();
29 :			use Data::Dumper;
30 :	sh002i	1985	use File::Temp qw/tempfile/;
31 :	sh002i	2138	use WeBWorK::CourseEnvironment;
32 :	gage	2242	use WeBWorK::Utils qw(cryptPassword writeLog);
33 :	sh002i	1960	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);
34 :	sh002i	1985	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
35 :	sh002i	1945
36 :	sh002i	1985	sub pre_header_initialize {
37 :			my ($self) = @_;
38 :			my $r = $self->r;
39 :			my $ce = $r->ce;
40 :			my $db = $r->db;
41 :			my $authz = $r->authz;
42 :			my $urlpath = $r->urlpath;
43 :	gage	2026	my $user = $r->param('user');
44 :	sh002i	1985
45 :	gage	2026	# check permissions
46 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47 :			$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48 :			return;
49 :			}
50 :
51 :	sh002i	1985	if (defined $r->param("download_exported_database")) {
52 :			my $courseID = $r->param("export_courseID");
53 :			my $random_chars = $r->param("download_exported_database");
54 :
55 :			die "courseID not specified" unless defined $courseID;
56 :			die "invalid file specification" unless $random_chars =~ m/^\w+$/;
57 :
58 :			my $tempdir = $ce->{webworkDirs}->{tmp};
59 :			my $export_file = "$tempdir/db_export_$random_chars";
60 :
61 :			$self->reply_with_file("text/xml", $export_file, "${courseID}_database.xml", 0);
62 :			}
63 :			}
64 :	sh002i	1945
65 :			sub body {
66 :			my ($self) = @_;
67 :			my $r = $self->r;
68 :			my $ce = $r->ce;
69 :			my $db = $r->db;
70 :			my $authz = $r->authz;
71 :			my $urlpath = $r->urlpath;
72 :
73 :	gage	2026	my $user = $r->param('user');
74 :
75 :			# check permissions
76 :			unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
77 :			return "";
78 :			}
79 :
80 :	sh002i	1960	print CGI::p({style=>"text-align: center"},
81 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
82 :			#" \| ",
83 :			#CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
84 :			" \| ",
85 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
86 :	sh002i	1985	" \| ",
87 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
88 :			" \| ",
89 :			CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
90 :	sh002i	1960	);
91 :	sh002i	1945
92 :	sh002i	1960	print CGI::hr();
93 :	sh002i	1945
94 :	sh002i	1960	my $subDisplay = $r->param("subDisplay");
95 :			if (defined $subDisplay) {
96 :	sh002i	1945
97 :	sh002i	1960	if ($subDisplay eq "add_course") {
98 :			if (defined $r->param("add_course")) {
99 :			my @errors = $self->add_course_validate;
100 :			if (@errors) {
101 :			print CGI::div({class=>"ResultsWithError"},
102 :			CGI::p("Please correct the following errors and try again:"),
103 :			CGI::ul(CGI::li(\@errors)),
104 :			);
105 :			$self->add_course_form;
106 :			} else {
107 :			$self->do_add_course;
108 :			}
109 :			} else {
110 :			$self->add_course_form;
111 :			}
112 :			}
113 :
114 :			elsif ($subDisplay eq "delete_course") {
115 :			if (defined $r->param("delete_course")) {
116 :			# validate or confirm
117 :			my @errors = $self->delete_course_validate;
118 :			if (@errors) {
119 :			print CGI::div({class=>"ResultsWithError"},
120 :			CGI::p("Please correct the following errors and try again:"),
121 :			CGI::ul(CGI::li(\@errors)),
122 :			);
123 :			$self->delete_course_form;
124 :			} else {
125 :			$self->delete_course_confirm;
126 :			}
127 :			} elsif (defined $r->param("confirm_delete_course")) {
128 :			# validate and delete
129 :			my @errors = $self->delete_course_validate;
130 :			if (@errors) {
131 :			print CGI::div({class=>"ResultsWithError"},
132 :			CGI::p("Please correct the following errors and try again:"),
133 :			CGI::ul(CGI::li(\@errors)),
134 :			);
135 :			$self->delete_course_form;
136 :			} else {
137 :			$self->do_delete_course;
138 :			}
139 :			} else {
140 :			# form only
141 :			$self->delete_course_form;
142 :			}
143 :			}
144 :
145 :	sh002i	1985	elsif ($subDisplay eq "export_database") {
146 :			if (defined $r->param("export_database")) {
147 :			my @errors = $self->export_database_validate;
148 :			if (@errors) {
149 :			print CGI::div({class=>"ResultsWithError"},
150 :			CGI::p("Please correct the following errors and try again:"),
151 :			CGI::ul(CGI::li(\@errors)),
152 :			);
153 :			$self->export_database_form;
154 :			} else {
155 :			$self->do_export_database;
156 :			}
157 :			} else {
158 :			$self->export_database_form;
159 :			}
160 :			}
161 :
162 :			elsif ($subDisplay eq "import_database") {
163 :			if (defined $r->param("import_database")) {
164 :			my @errors = $self->import_database_validate;
165 :			if (@errors) {
166 :			print CGI::div({class=>"ResultsWithError"},
167 :			CGI::p("Please correct the following errors and try again:"),
168 :			CGI::ul(CGI::li(\@errors)),
169 :			);
170 :			$self->import_database_form;
171 :			} else {
172 :			$self->do_import_database;
173 :			}
174 :			} else {
175 :			$self->import_database_form;
176 :			}
177 :			}
178 :
179 :			else {
180 :			print CGI::div({class=>"ResultsWithError"},
181 :			"Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.");
182 :			}
183 :
184 :	sh002i	1960	}
185 :	sh002i	1945
186 :	sh002i	1960	return "";
187 :			}
188 :
189 :	sh002i	1985	################################################################################
190 :
191 :	sh002i	1960	sub add_course_form {
192 :			my ($self) = @_;
193 :			my $r = $self->r;
194 :			my $ce = $r->ce;
195 :			#my $db = $r->db;
196 :			#my $authz = $r->authz;
197 :			#my $urlpath = $r->urlpath;
198 :	sh002i	1945
199 :	gage	2254	my $add_courseID = $r->param("add_courseID") \|\| "";
200 :	sh002i	2378	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
201 :			my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
202 :
203 :			my $add_admin_users = $r->param("add_admin_users") \|\| "";
204 :
205 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
206 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
207 :			my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
208 :			my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
209 :			my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
210 :			my $add_initial_email = $r->param("add_initial_email") \|\| "";
211 :
212 :			my $add_templates_course = $r->param("add_templates_course") \|\| "";
213 :
214 :	gage	2254	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
215 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
216 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
217 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
218 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
219 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
220 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
221 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
222 :	sh002i	1945
223 :	sh002i	1960	my @dbLayouts = sort keys %{ $ce->{dbLayouts} };
224 :
225 :			my $ce2 = WeBWorK::CourseEnvironment->new(
226 :			$ce->{webworkDirs}->{root},
227 :			$ce->{webworkURLs}->{root},
228 :			$ce->{pg}->{directories}->{root},
229 :			"COURSENAME",
230 :			);
231 :
232 :			my $dbi_source = do {
233 :			# find the most common SQL source (stolen from CourseManagement.pm)
234 :			my %sources;
235 :			foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
236 :			$sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
237 :	sh002i	1945	}
238 :	sh002i	1960	my $source;
239 :			if (keys %sources > 1) {
240 :			foreach my $curr (keys %sources) {
241 :	jj	2023	$source = $curr if not defined $source or
242 :			$sources{$curr} > $sources{$source};
243 :	sh002i	1960	}
244 :			} else {
245 :			($source) = keys %sources;
246 :			}
247 :			$source;
248 :			};
249 :	sh002i	1945
250 :	sh002i	2378	my @existingCourses = listCourses($ce);
251 :			@existingCourses = sort @existingCourses;
252 :	sh002i	2148
253 :	sh002i	1960	print CGI::h2("Add Course");
254 :	sh002i	1945
255 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
256 :			print $self->hidden_authen_fields;
257 :			print $self->hidden_fields("subDisplay");
258 :	sh002i	1945
259 :	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.");
260 :	sh002i	1960
261 :			print CGI::table({class=>"FormLayout"},
262 :			CGI::Tr(
263 :	gage	2242	CGI::th({class=>"LeftHeader"}, "Course ID:"),
264 :	sh002i	1960	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
265 :			),
266 :	gage	2242	CGI::Tr(
267 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Course Title:"),
268 :			CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)),
269 :	gage	2242	),
270 :			CGI::Tr(
271 :	sh002i	2378	CGI::th({class=>"LeftHeader"}, "Institution:"),
272 :			CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
273 :	gage	2242	),
274 :	sh002i	2378	);
275 :
276 :			print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
277 :
278 :			print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course"));
279 :
280 :			print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only numbers, letters, hyphens, and underscores.");
281 :
282 :			print CGI::table({class=>"FormLayout"}, CGI::Tr(
283 :			CGI::td(
284 :			CGI::table({class=>"FormLayout"},
285 :			CGI::Tr(
286 :			CGI::th({class=>"LeftHeader"}, "User ID:"),
287 :			CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)),
288 :			),
289 :			CGI::Tr(
290 :			CGI::th({class=>"LeftHeader"}, "Password:"),
291 :			CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
292 :			),
293 :			CGI::Tr(
294 :			CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
295 :			CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)),
296 :			),
297 :			),
298 :	gage	2299	),
299 :	sh002i	2378	CGI::td(
300 :			CGI::table({class=>"FormLayout"},
301 :			CGI::Tr(
302 :			CGI::th({class=>"LeftHeader"}, "First Name:"),
303 :			CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)),
304 :			),
305 :			CGI::Tr(
306 :			CGI::th({class=>"LeftHeader"}, "Last Name:"),
307 :			CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)),
308 :			),
309 :			CGI::Tr(
310 :			CGI::th({class=>"LeftHeader"}, "Email Address:"),
311 :			CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)),
312 :			),
313 :			),
314 :	gage	2242
315 :			),
316 :	sh002i	2378	));
317 :	gage	2254
318 :	sh002i	2378	print CGI::p("To copy problem templates from an existing course, select the course below.");
319 :	gage	2254
320 :			print CGI::table({class=>"FormLayout"},
321 :			CGI::Tr(
322 :			CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
323 :			CGI::td(
324 :			CGI::popup_menu(
325 :			-name => "add_templates_course",
326 :			-values => [ "", @existingCourses ],
327 :			-default => $add_templates_course,
328 :			#-size => 10,
329 :			#-multiple => 0,
330 :			#-labels => \%courseLabels,
331 :			),
332 :
333 :			),
334 :			),
335 :			);
336 :
337 :	sh002i	2378	print CGI::p("Select a database layout below.");
338 :	sh002i	1960
339 :			foreach my $dbLayout (@dbLayouts) {
340 :			print CGI::start_table({class=>"FormLayout"});
341 :
342 :			# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
343 :			print CGI::Tr(
344 :			CGI::td({style=>"text-align: right"},
345 :			'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
346 :			. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
347 :	sh002i	1945	),
348 :	sh002i	1960	CGI::td($dbLayout),
349 :	sh002i	1945	);
350 :
351 :	sh002i	1960	print CGI::start_Tr();
352 :			print CGI::td(); # for indentation :(
353 :			print CGI::start_td();
354 :	sh002i	1945
355 :	sh002i	1960	if ($dbLayout eq "sql") {
356 :	gage	2254	print CGI::start_table({class=>"FormLayout"});
357 :			print CGI::Tr(CGI::td({colspan=>2},
358 :	sh002i	2378	"Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
359 :	gage	2254	)
360 :	sh002i	1960	);
361 :	sh002i	1945	print CGI::Tr(
362 :	gage	2254	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
363 :			CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
364 :			);
365 :			print CGI::Tr(
366 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
367 :			CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
368 :			);
369 :
370 :	sh002i	2378	print CGI::Tr(CGI::td({colspan=>2},
371 :			"The optionial SQL settings you enter below must match the settings in the DBI source"
372 :			. " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
373 :			. " with the course name you entered above."
374 :	gage	2254	)
375 :			);
376 :			print CGI::Tr(
377 :	sh002i	1945	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
378 :			CGI::td(
379 :	sh002i	1960	CGI::textfield("add_sql_host", $add_sql_host, 25),
380 :	sh002i	1945	CGI::br(),
381 :			CGI::small("Leave blank to use the default host."),
382 :			),
383 :			);
384 :			print CGI::Tr(
385 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
386 :			CGI::td(
387 :	sh002i	1960	CGI::textfield("add_sql_port", $add_sql_port, 25),
388 :	sh002i	1945	CGI::br(),
389 :			CGI::small("Leave blank to use the default port."),
390 :			),
391 :			);
392 :	gage	2254
393 :	sh002i	1945	print CGI::Tr(
394 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
395 :	sh002i	2104	CGI::td(
396 :			CGI::textfield("add_sql_database", $add_sql_database, 25),
397 :			CGI::br(),
398 :			CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
399 :			),
400 :	sh002i	1945	);
401 :			print CGI::Tr(
402 :			CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
403 :			CGI::td(
404 :	sh002i	1960	CGI::textfield("add_sql_wwhost", $add_sql_wwhost \|\| "localhost", 25),
405 :	sh002i	1945	CGI::br(),
406 :			CGI::small("If the SQL server does not run on the same host as WeBWorK, enter the host name of the WeBWorK server as seen by the SQL server."),
407 :			),
408 :			);
409 :	sh002i	1960	print CGI::end_table();
410 :			} elsif ($dbLayout eq "gdbm") {
411 :	sh002i	1945	print CGI::start_table({class=>"FormLayout"});
412 :			print CGI::Tr(
413 :			CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
414 :	sh002i	2004	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),
415 :	sh002i	1945	);
416 :	sh002i	1960	print CGI::end_table();
417 :	sh002i	1945	}
418 :
419 :	sh002i	1960	print CGI::end_td();
420 :			print CGI::end_Tr();
421 :	sh002i	1945	print CGI::end_table();
422 :			}
423 :
424 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
425 :
426 :			print CGI::end_form();
427 :			}
428 :
429 :			sub add_course_validate {
430 :			my ($self) = @_;
431 :			my $r = $self->r;
432 :			my $ce = $r->ce;
433 :			#my $db = $r->db;
434 :			#my $authz = $r->authz;
435 :			#my $urlpath = $r->urlpath;
436 :
437 :	gage	2254	my $add_courseID = $r->param("add_courseID") \|\| "";
438 :	sh002i	2378	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
439 :			my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
440 :
441 :			my $add_admin_users = $r->param("add_admin_users") \|\| "";
442 :
443 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
444 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
445 :			my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
446 :			my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
447 :			my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
448 :			my $add_initial_email = $r->param("add_initial_email") \|\| "";
449 :
450 :			my $add_templates_course = $r->param("add_templates_course") \|\| "";
451 :
452 :	gage	2254	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
453 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
454 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
455 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
456 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
457 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
458 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
459 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
460 :	sh002i	2378
461 :	sh002i	1960	my @errors;
462 :
463 :			if ($add_courseID eq "") {
464 :	sh002i	2378	push @errors, "You must specify a course ID.";
465 :	sh002i	1960	}
466 :	sh002i	2373	if (grep { $add_courseID eq $_ } listCourses($ce)) {
467 :	sh002i	2378	push @errors, "A course with ID $add_courseID already exists.";
468 :	sh002i	2373	}
469 :	sh002i	2378	if ($add_courseTitle eq "") {
470 :			push @errors, "You must specify a course title.";
471 :	gage	2242	}
472 :	sh002i	2378	if ($add_courseInstitution eq "") {
473 :			push @errors, "You must specify an institution for this course.";
474 :	gage	2242	}
475 :	sh002i	2378
476 :			if ($add_initial_userID ne "") {
477 :			if ($add_initial_password eq "") {
478 :			push @errors, "You must specify a password for the initial instructor.";
479 :			}
480 :			if ($add_initial_confirmPassword eq "") {
481 :			push @errors, "You must confirm the password for the initial instructor.";
482 :			}
483 :			if ($add_initial_password ne $add_initial_confirmPassword) {
484 :			push @errors, "The password and password confirmation for the instructor must match.";
485 :			}
486 :			if ($add_initial_firstName eq "") {
487 :			push @errors, "You must specify a first name for the initial instructor.";
488 :			}
489 :			if ($add_initial_lastName eq "") {
490 :			push @errors, "You must specify a last name for the initial instructor.";
491 :			}
492 :			if ($add_initial_email eq "") {
493 :			push @errors, "You must specify an email address for the initial instructor.";
494 :			}
495 :	gage	2242	}
496 :	sh002i	1960
497 :			if ($add_dbLayout eq "") {
498 :			push @errors, "You must select a database layout.";
499 :			} else {
500 :			if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
501 :			if ($add_dbLayout eq "sql") {
502 :			push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
503 :			push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
504 :			} elsif ($add_dbLayout eq "gdbm") {
505 :			push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
506 :			}
507 :			} else {
508 :			push @errors, "The database layout $add_dbLayout doesn't exist.";
509 :			}
510 :			}
511 :
512 :			return @errors;
513 :			}
514 :
515 :			sub do_add_course {
516 :			my ($self) = @_;
517 :			my $r = $self->r;
518 :			my $ce = $r->ce;
519 :			my $db = $r->db;
520 :			#my $authz = $r->authz;
521 :			my $urlpath = $r->urlpath;
522 :
523 :	sh002i	2378	my $add_courseID = $r->param("add_courseID") \|\| "";
524 :			my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
525 :			my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
526 :
527 :			my $add_admin_users = $r->param("add_admin_users") \|\| "";
528 :
529 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
530 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
531 :			my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
532 :			my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
533 :			my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
534 :			my $add_initial_email = $r->param("add_initial_email") \|\| "";
535 :
536 :			my $add_templates_course = $r->param("add_templates_course") \|\| "";
537 :
538 :			my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
539 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
540 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
541 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
542 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
543 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
544 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
545 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
546 :	gage	2242
547 :	sh002i	1960	my $ce2 = WeBWorK::CourseEnvironment->new(
548 :			$ce->{webworkDirs}->{root},
549 :			$ce->{webworkURLs}->{root},
550 :			$ce->{pg}->{directories}->{root},
551 :			$add_courseID,
552 :			);
553 :
554 :	gage	2042	my %courseOptions = ( dbLayoutName => $add_dbLayout );
555 :	sh002i	2384
556 :			if ($add_initial_email ne "") {
557 :			$courseOptions{allowedRecipients} = [ $add_initial_email ];
558 :			$courseOptions{feedbackRecipients} = [ $add_initial_email ];
559 :			}
560 :
561 :	sh002i	2004	if ($add_dbLayout eq "gdbm") {
562 :			$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
563 :			}
564 :
565 :	sh002i	1960	my %dbOptions;
566 :			if ($add_dbLayout eq "sql") {
567 :			$dbOptions{host} = $add_sql_host if $add_sql_host ne "";
568 :			$dbOptions{port} = $add_sql_port if $add_sql_port ne "";
569 :			$dbOptions{username} = $add_sql_username;
570 :			$dbOptions{password} = $add_sql_password;
571 :	sh002i	2104	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";
572 :	sh002i	1960	$dbOptions{wwhost} = $add_sql_wwhost;
573 :			}
574 :	sh002i	2378
575 :	sh002i	1960	my @users;
576 :	sh002i	2378
577 :			# copy users from current (admin) course if desired
578 :			if ($add_admin_users ne "") {
579 :			foreach my $userID ($db->listUsers) {
580 :			my $User = $db->getUser($userID);
581 :			my $Password = $db->getPassword($userID);
582 :			my $PermissionLevel = $db->getPermissionLevel($userID);
583 :			push @users, [ $User, $Password, $PermissionLevel ];
584 :			}
585 :			}
586 :
587 :			# add initial instructor if desired
588 :	sh002i	1960	if ($add_initial_userID ne "") {
589 :	sh002i	2004	my $User = $db->newUser(
590 :	sh002i	2384	user_id => $add_initial_userID,
591 :			first_name => $add_initial_firstName,
592 :			last_name => $add_initial_lastName,
593 :			student_id => $add_initial_userID,
594 :			email_address => $add_initial_email,
595 :			status => "C",
596 :	sh002i	2004	);
597 :			my $Password = $db->newPassword(
598 :	sh002i	2378	user_id => $add_initial_userID,
599 :	sh002i	1960	password => cryptPassword($add_initial_password),
600 :	sh002i	2004	);
601 :			my $PermissionLevel = $db->newPermissionLevel(
602 :	sh002i	2378	user_id => $add_initial_userID,
603 :	sh002i	1960	permission => "10",
604 :	sh002i	2004	);
605 :			push @users, [ $User, $Password, $PermissionLevel ];
606 :	sh002i	1960	}
607 :	sh002i	2378
608 :	sh002i	2384	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users;
609 :
610 :	sh002i	2148	my %optional_arguments;
611 :			if ($add_templates_course ne "") {
612 :			$optional_arguments{templatesFrom} = $add_templates_course;
613 :			}
614 :
615 :	sh002i	1960	eval {
616 :			addCourse(
617 :	sh002i	2004	courseID => $add_courseID,
618 :			ce => $ce2,
619 :			courseOptions => \%courseOptions,
620 :			dbOptions => \%dbOptions,
621 :			users => \@users,
622 :	sh002i	2148	%optional_arguments,
623 :	sh002i	1945	);
624 :	sh002i	1960	};
625 :			if ($@) {
626 :			my $error = $@;
627 :			print CGI::div({class=>"ResultsWithError"},
628 :			CGI::p("An error occured while creating the course $add_courseID:"),
629 :			CGI::tt(CGI::escapeHTML($error)),
630 :			);
631 :	gage	2254	# get rid of any partially built courses
632 :			# FIXME -- this is too fragile
633 :			unless ($error =~ /course exists/) {
634 :			eval {
635 :			deleteCourse(
636 :			courseID => $add_courseID,
637 :			ce => $ce2,
638 :			dbOptions => \%dbOptions,
639 :			);
640 :			}
641 :			}
642 :	sh002i	1960	} else {
643 :	gage	2256	#log the action
644 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
645 :			"\tAdded",
646 :	sh002i	2378	$add_courseInstitution,
647 :			$add_courseTitle,
648 :	gage	2242	$add_courseID,
649 :	sh002i	2378	$add_initial_firstName,
650 :			$add_initial_lastName,
651 :			$add_initial_email,
652 :	gage	2242	));
653 :	gage	2256	# add contact to admin course as student?
654 :			# FIXME -- should we do this?
655 :	sh002i	1960	print CGI::div({class=>"ResultsWithoutError"},
656 :			CGI::p("Successfully created the course $add_courseID"),
657 :			);
658 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
659 :			courseID => $add_courseID);
660 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
661 :			print CGI::div({style=>"text-align: center"},
662 :			CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
663 :			);
664 :			}
665 :	gage	2322
666 :	gage	2299
667 :	sh002i	1960	}
668 :
669 :			################################################################################
670 :
671 :			sub delete_course_form {
672 :			my ($self) = @_;
673 :			my $r = $self->r;
674 :			my $ce = $r->ce;
675 :			#my $db = $r->db;
676 :			#my $authz = $r->authz;
677 :			#my $urlpath = $r->urlpath;
678 :
679 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
680 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
681 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
682 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
683 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
684 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
685 :
686 :			my @courseIDs = listCourses($ce);
687 :	gage	2045	@courseIDs = sort @courseIDs;
688 :	sh002i	1960
689 :			my %courseLabels; # records... heh.
690 :			foreach my $courseID (@courseIDs) {
691 :			my $tempCE = WeBWorK::CourseEnvironment->new(
692 :			$ce->{webworkDirs}->{root},
693 :			$ce->{webworkURLs}->{root},
694 :			$ce->{pg}->{directories}->{root},
695 :			$courseID,
696 :			);
697 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
698 :			}
699 :
700 :			print CGI::h2("Delete Course");
701 :
702 :			print CGI::start_form("POST", $r->uri);
703 :			print $self->hidden_authen_fields;
704 :			print $self->hidden_fields("subDisplay");
705 :
706 :			print CGI::p("Select a course to delete.");
707 :
708 :			print CGI::table({class=>"FormLayout"},
709 :			CGI::Tr(
710 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
711 :	sh002i	1945	CGI::td(
712 :	sh002i	1960	CGI::scrolling_list(
713 :			-name => "delete_courseID",
714 :			-values => \@courseIDs,
715 :			-default => $delete_courseID,
716 :			-size => 10,
717 :			-multiple => 0,
718 :			-labels => \%courseLabels,
719 :	sh002i	1945	),
720 :			),
721 :	sh002i	1960	),
722 :			);
723 :
724 :			print CGI::p(
725 :			"If the course's database layout (indicated in parentheses above) is "
726 :			. CGI::b("sql") . ", supply the SQL connections information requested below."
727 :			);
728 :
729 :			print CGI::start_table({class=>"FormLayout"});
730 :			print CGI::Tr(
731 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
732 :			CGI::td(
733 :			CGI::textfield("delete_sql_host", $delete_sql_host, 25),
734 :			CGI::br(),
735 :			CGI::small("Leave blank to use the default host."),
736 :			),
737 :			);
738 :			print CGI::Tr(
739 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
740 :			CGI::td(
741 :			CGI::textfield("delete_sql_port", $delete_sql_port, 25),
742 :			CGI::br(),
743 :			CGI::small("Leave blank to use the default port."),
744 :			),
745 :			);
746 :			print CGI::Tr(
747 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
748 :			CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
749 :			);
750 :			print CGI::Tr(
751 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
752 :			CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
753 :			);
754 :			print CGI::Tr(
755 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
756 :	sh002i	2189	CGI::td(
757 :			CGI::textfield("delete_sql_database", $delete_sql_database, 25),
758 :			CGI::br(),
759 :			CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
760 :			),
761 :	sh002i	1960	);
762 :			print CGI::end_table();
763 :
764 :			print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
765 :
766 :			print CGI::end_form();
767 :			}
768 :
769 :			sub delete_course_validate {
770 :			my ($self) = @_;
771 :			my $r = $self->r;
772 :			my $ce = $r->ce;
773 :			#my $db = $r->db;
774 :			#my $authz = $r->authz;
775 :			my $urlpath = $r->urlpath;
776 :
777 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
778 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
779 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
780 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
781 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
782 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
783 :
784 :			my @errors;
785 :
786 :			if ($delete_courseID eq "") {
787 :			push @errors, "You must specify a course name.";
788 :			} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
789 :			push @errors, "You cannot delete the course you are currently using.";
790 :			}
791 :
792 :			my $ce2 = WeBWorK::CourseEnvironment->new(
793 :			$ce->{webworkDirs}->{root},
794 :			$ce->{webworkURLs}->{root},
795 :			$ce->{pg}->{directories}->{root},
796 :			$delete_courseID,
797 :			);
798 :
799 :			if ($ce2->{dbLayoutName} eq "sql") {
800 :			push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
801 :	sh002i	2189	#push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
802 :			#push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
803 :	sh002i	1960	}
804 :
805 :			return @errors;
806 :			}
807 :
808 :			sub delete_course_confirm {
809 :			my ($self) = @_;
810 :			my $r = $self->r;
811 :			my $ce = $r->ce;
812 :			#my $db = $r->db;
813 :			#my $authz = $r->authz;
814 :			#my $urlpath = $r->urlpath;
815 :
816 :			print CGI::h2("Delete Course");
817 :
818 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
819 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
820 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
821 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
822 :
823 :			my $ce2 = WeBWorK::CourseEnvironment->new(
824 :			$ce->{webworkDirs}->{root},
825 :			$ce->{webworkURLs}->{root},
826 :			$ce->{pg}->{directories}->{root},
827 :			$delete_courseID,
828 :			);
829 :
830 :			if ($ce2->{dbLayoutName} eq "sql") {
831 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
832 :			. "? All course files and data and the following database will be destroyed."
833 :			. " There is no undo available.");
834 :
835 :			print CGI::table({class=>"FormLayout"},
836 :			CGI::Tr(
837 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
838 :			CGI::td($delete_sql_host \|\| "system default"),
839 :	sh002i	1945	),
840 :	sh002i	1960	CGI::Tr(
841 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
842 :			CGI::td($delete_sql_port \|\| "system default"),
843 :			),
844 :			CGI::Tr(
845 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
846 :	sh002i	2189	CGI::td($delete_sql_database \|\| "webwork_$delete_courseID"),
847 :	sh002i	1960	),
848 :	sh002i	1945	);
849 :	sh002i	1960	} else {
850 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
851 :			. "? All course files and data will be destroyed. There is no undo available.");
852 :	sh002i	1945	}
853 :
854 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
855 :			print $self->hidden_authen_fields;
856 :			print $self->hidden_fields("subDisplay");
857 :			print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
858 :
859 :			print CGI::p({style=>"text-align: center"},
860 :			CGI::submit("decline_delete_course", "Don't delete"),
861 :			" ",
862 :			CGI::submit("confirm_delete_course", "Delete"),
863 :			);
864 :
865 :			print CGI::end_form();
866 :			}
867 :
868 :			sub do_delete_course {
869 :			my ($self) = @_;
870 :			my $r = $self->r;
871 :			my $ce = $r->ce;
872 :			#my $db = $r->db;
873 :			#my $authz = $r->authz;
874 :			#my $urlpath = $r->urlpath;
875 :
876 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
877 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
878 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
879 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
880 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
881 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
882 :
883 :			my $ce2 = WeBWorK::CourseEnvironment->new(
884 :			$ce->{webworkDirs}->{root},
885 :			$ce->{webworkURLs}->{root},
886 :			$ce->{pg}->{directories}->{root},
887 :			$delete_courseID,
888 :			);
889 :
890 :			my %dbOptions;
891 :			if ($ce2->{dbLayoutName} eq "sql") {
892 :			$dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
893 :			$dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
894 :			$dbOptions{username} = $delete_sql_username;
895 :			$dbOptions{password} = $delete_sql_password;
896 :	sh002i	2189	$dbOptions{database} = $delete_sql_database \|\| "webwork_$delete_courseID";
897 :	sh002i	1960	}
898 :
899 :			eval {
900 :			deleteCourse(
901 :			courseID => $delete_courseID,
902 :			ce => $ce2,
903 :			dbOptions => \%dbOptions,
904 :			);
905 :			};
906 :
907 :			if ($@) {
908 :			my $error = $@;
909 :			print CGI::div({class=>"ResultsWithError"},
910 :			CGI::p("An error occured while deleting the course $delete_courseID:"),
911 :			CGI::tt(CGI::escapeHTML($error)),
912 :			);
913 :			} else {
914 :			print CGI::div({class=>"ResultsWithoutError"},
915 :	sh002i	2378	CGI::p("Successfully deleted the course $delete_courseID."),
916 :	sh002i	1960	);
917 :	gage	2242	writeLog($ce, "hosted_courses", join("\t",
918 :			"\tDeleted",
919 :			"",
920 :			"",
921 :			$delete_courseID,
922 :			));
923 :	sh002i	1945	print CGI::start_form("POST", $r->uri);
924 :			print $self->hidden_authen_fields;
925 :	sh002i	1960	print $self->hidden_fields("subDisplay");
926 :	sh002i	1945
927 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
928 :	sh002i	1945
929 :	sh002i	1960	print CGI::end_form();
930 :	sh002i	1945	}
931 :			}
932 :
933 :	sh002i	1985	################################################################################
934 :
935 :			sub export_database_form {
936 :			my ($self) = @_;
937 :			my $r = $self->r;
938 :			my $ce = $r->ce;
939 :			#my $db = $r->db;
940 :			#my $authz = $r->authz;
941 :			#my $urlpath = $r->urlpath;
942 :
943 :			my @tables = keys %{$ce->{dbLayout}};
944 :
945 :			my $export_courseID = $r->param("export_courseID") \|\| "";
946 :			my @export_tables = $r->param("export_tables");
947 :
948 :			@export_tables = @tables unless @export_tables;
949 :
950 :			my @courseIDs = listCourses($ce);
951 :	gage	2045	@courseIDs = sort @courseIDs;
952 :	sh002i	1985
953 :			my %courseLabels; # records... heh.
954 :			foreach my $courseID (@courseIDs) {
955 :			my $tempCE = WeBWorK::CourseEnvironment->new(
956 :			$ce->{webworkDirs}->{root},
957 :			$ce->{webworkURLs}->{root},
958 :			$ce->{pg}->{directories}->{root},
959 :			$courseID,
960 :			);
961 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
962 :			}
963 :
964 :			print CGI::h2("Export Database");
965 :
966 :			print CGI::start_form("POST", $r->uri);
967 :			print $self->hidden_authen_fields;
968 :			print $self->hidden_fields("subDisplay");
969 :
970 :			print CGI::p("Select a course to export the course's database.");
971 :
972 :			print CGI::table({class=>"FormLayout"},
973 :			CGI::Tr(
974 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
975 :			CGI::td(
976 :			CGI::scrolling_list(
977 :			-name => "export_courseID",
978 :			-values => \@courseIDs,
979 :			-default => $export_courseID,
980 :			-size => 10,
981 :			-multiple => 0,
982 :			-labels => \%courseLabels,
983 :			),
984 :			),
985 :			),
986 :			CGI::Tr(
987 :			CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
988 :			CGI::td(
989 :			CGI::checkbox_group(
990 :			-name => "export_tables",
991 :			-values => \@tables,
992 :			-default => \@export_tables,
993 :			-linebreak => 1,
994 :			),
995 :			),
996 :			),
997 :			);
998 :
999 :			print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
1000 :
1001 :			print CGI::end_form();
1002 :			}
1003 :
1004 :			sub export_database_validate {
1005 :			my ($self) = @_;
1006 :			my $r = $self->r;
1007 :			#my $ce = $r->ce;
1008 :			#my $db = $r->db;
1009 :			#my $authz = $r->authz;
1010 :			#my $urlpath = $r->urlpath;
1011 :
1012 :			my $export_courseID = $r->param("export_courseID") \|\| "";
1013 :			my @export_tables = $r->param("export_tables");
1014 :
1015 :			my @errors;
1016 :
1017 :			if ($export_courseID eq "") {
1018 :			push @errors, "You must specify a course name.";
1019 :			}
1020 :
1021 :			unless (@export_tables) {
1022 :			push @errors, "You must specify at least one table to export.";
1023 :			}
1024 :
1025 :			return @errors;
1026 :			}
1027 :
1028 :			sub do_export_database {
1029 :			my ($self) = @_;
1030 :			my $r = $self->r;
1031 :			my $ce = $r->ce;
1032 :			#my $db = $r->db;
1033 :			#my $authz = $r->authz;
1034 :			my $urlpath = $r->urlpath;
1035 :
1036 :			my $export_courseID = $r->param("export_courseID");
1037 :			my @export_tables = $r->param("export_tables");
1038 :
1039 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1040 :			$ce->{webworkDirs}->{root},
1041 :			$ce->{webworkURLs}->{root},
1042 :			$ce->{pg}->{directories}->{root},
1043 :			$export_courseID,
1044 :			);
1045 :
1046 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1047 :
1048 :			my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1049 :			my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1050 :
1051 :			my @errors;
1052 :
1053 :			eval {
1054 :			@errors = dbExport(
1055 :			db => $db2,
1056 :			xml => $fh,
1057 :			tables => \@export_tables,
1058 :			);
1059 :			};
1060 :
1061 :			push @errors, "Fatal exception: $@" if $@;
1062 :
1063 :			if (@errors) {
1064 :			print CGI::div({class=>"ResultsWithError"},
1065 :			CGI::p("An error occured while exporting the database of course $export_courseID:"),
1066 :			CGI::ul(CGI::li(\@errors)),
1067 :			);
1068 :			} else {
1069 :			print CGI::div({class=>"ResultsWithoutError"},
1070 :			CGI::p("Export succeeded."),
1071 :			);
1072 :
1073 :			print CGI::div({style=>"text-align: center"},
1074 :			CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1075 :			);
1076 :			}
1077 :			}
1078 :
1079 :			################################################################################
1080 :
1081 :			sub import_database_form {
1082 :			my ($self) = @_;
1083 :			my $r = $self->r;
1084 :			my $ce = $r->ce;
1085 :			#my $db = $r->db;
1086 :			#my $authz = $r->authz;
1087 :			#my $urlpath = $r->urlpath;
1088 :
1089 :			my @tables = keys %{$ce->{dbLayout}};
1090 :
1091 :			my $import_file = $r->param("import_file") \|\| "";
1092 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1093 :			my @import_tables = $r->param("import_tables");
1094 :			my $import_conflict = $r->param("import_conflict") \|\| "skip";
1095 :
1096 :			@import_tables = @tables unless @import_tables;
1097 :
1098 :			my @courseIDs = listCourses($ce);
1099 :	gage	2045	@courseIDs = sort @courseIDs;
1100 :
1101 :	sh002i	1985
1102 :			my %courseLabels; # records... heh.
1103 :			foreach my $courseID (@courseIDs) {
1104 :			my $tempCE = WeBWorK::CourseEnvironment->new(
1105 :			$ce->{webworkDirs}->{root},
1106 :			$ce->{webworkURLs}->{root},
1107 :			$ce->{pg}->{directories}->{root},
1108 :			$courseID,
1109 :			);
1110 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1111 :			}
1112 :
1113 :			print CGI::h2("Import Database");
1114 :
1115 :			print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1116 :			print $self->hidden_authen_fields;
1117 :			print $self->hidden_fields("subDisplay");
1118 :
1119 :			print CGI::table({class=>"FormLayout"},
1120 :			CGI::Tr(
1121 :			CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1122 :			CGI::td(
1123 :			CGI::filefield(
1124 :			-name => "import_file",
1125 :			-size => 50,
1126 :			),
1127 :			),
1128 :			),
1129 :			CGI::Tr(
1130 :			CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1131 :			CGI::td(
1132 :			CGI::checkbox_group(
1133 :			-name => "import_tables",
1134 :			-values => \@tables,
1135 :			-default => \@import_tables,
1136 :			-linebreak => 1,
1137 :			),
1138 :			),
1139 :			),
1140 :			CGI::Tr(
1141 :			CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1142 :			CGI::td(
1143 :			CGI::scrolling_list(
1144 :			-name => "import_courseID",
1145 :			-values => \@courseIDs,
1146 :			-default => $import_courseID,
1147 :			-size => 10,
1148 :			-multiple => 0,
1149 :			-labels => \%courseLabels,
1150 :			),
1151 :			),
1152 :			),
1153 :			CGI::Tr(
1154 :			CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1155 :			CGI::td(
1156 :			CGI::radio_group(
1157 :			-name => "import_conflict",
1158 :			-values => [qw/skip replace/],
1159 :			-default => $import_conflict,
1160 :			-linebreak=>'true',
1161 :			-labels => {
1162 :			skip => "Skip duplicate records",
1163 :			replace => "Replace duplicate records",
1164 :			},
1165 :			),
1166 :			),
1167 :			),
1168 :			);
1169 :
1170 :			print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1171 :
1172 :			print CGI::end_form();
1173 :			}
1174 :
1175 :			sub import_database_validate {
1176 :			my ($self) = @_;
1177 :			my $r = $self->r;
1178 :			#my $ce = $r->ce;
1179 :			#my $db = $r->db;
1180 :			#my $authz = $r->authz;
1181 :			#my $urlpath = $r->urlpath;
1182 :
1183 :			my $import_file = $r->param("import_file") \|\| "";
1184 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1185 :			my @import_tables = $r->param("import_tables");
1186 :			#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1187 :
1188 :			my @errors;
1189 :
1190 :			if ($import_file eq "") {
1191 :			push @errors, "You must specify a database file to upload.";
1192 :			}
1193 :
1194 :			if ($import_courseID eq "") {
1195 :			push @errors, "You must specify a course name.";
1196 :			}
1197 :
1198 :			unless (@import_tables) {
1199 :			push @errors, "You must specify at least one table to import.";
1200 :			}
1201 :
1202 :			return @errors;
1203 :			}
1204 :
1205 :			sub do_import_database {
1206 :			my ($self) = @_;
1207 :			my $r = $self->r;
1208 :			my $ce = $r->ce;
1209 :			#my $db = $r->db;
1210 :			#my $authz = $r->authz;
1211 :			my $urlpath = $r->urlpath;
1212 :
1213 :			my $import_file = $r->param("import_file");
1214 :			my $import_courseID = $r->param("import_courseID");
1215 :			my @import_tables = $r->param("import_tables");
1216 :			my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
1217 :
1218 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1219 :			$ce->{webworkDirs}->{root},
1220 :			$ce->{webworkURLs}->{root},
1221 :			$ce->{pg}->{directories}->{root},
1222 :			$import_courseID,
1223 :			);
1224 :
1225 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1226 :
1227 :			# retrieve upload from upload cache
1228 :			my ($id, $hash) = split /\s+/, $import_file;
1229 :			my $upload = WeBWorK::Upload->retrieve($id, $hash,
1230 :			dir => $ce->{webworkDirs}->{uploadCache}
1231 :			);
1232 :
1233 :			my @errors;
1234 :
1235 :			eval {
1236 :			@errors = dbImport(
1237 :			db => $db2,
1238 :			xml => $upload->fileHandle,
1239 :			tables => \@import_tables,
1240 :			conflict => $import_conflict,
1241 :			);
1242 :			};
1243 :
1244 :			$upload->dispose;
1245 :
1246 :			push @errors, "Fatal exception: $@" if $@;
1247 :
1248 :			if (@errors) {
1249 :			print CGI::div({class=>"ResultsWithError"},
1250 :			CGI::p("An error occured while importing the database of course $import_courseID:"),
1251 :			CGI::ul(CGI::li(\@errors)),
1252 :			);
1253 :			} else {
1254 :			print CGI::div({class=>"ResultsWithoutError"},
1255 :			CGI::p("Import succeeded."),
1256 :			);
1257 :			}
1258 :			}
1259 :
1260 :	sh002i	1945	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9