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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9