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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9