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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9