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

Revision 3437 - (view) (download) (as text)
Original Path: trunk/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9