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

Revision 2004 - (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	2004	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.3 2004/04/29 22:22:33 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 :			$source = $curr if @{ $sources{$curr} } > @{ $sources{$source} };
299 :			}
300 :			} else {
301 :			($source) = keys %sources;
302 :			}
303 :			$source;
304 :			};
305 :	sh002i	1945
306 :	sh002i	1960	print CGI::h2("Add Course");
307 :	sh002i	1945
308 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
309 :			print $self->hidden_authen_fields;
310 :			print $self->hidden_fields("subDisplay");
311 :	sh002i	1945
312 :	sh002i	1960	print CGI::p("Specify a name for the new course.");
313 :
314 :			print CGI::table({class=>"FormLayout"},
315 :			CGI::Tr(
316 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
317 :			CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
318 :			),
319 :			);
320 :
321 :			print CGI::p("Select a database layout below. Some database layouts require additional information.");
322 :
323 :			#print CGI::start_Tr();
324 :			#print CGI::th({class=>"LeftHeader"}, "Database Layout:");
325 :			#print CGI::start_td();
326 :
327 :			foreach my $dbLayout (@dbLayouts) {
328 :			print CGI::start_table({class=>"FormLayout"});
329 :
330 :			# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
331 :			print CGI::Tr(
332 :			CGI::td({style=>"text-align: right"},
333 :			'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
334 :			. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
335 :	sh002i	1945	),
336 :	sh002i	1960	CGI::td($dbLayout),
337 :	sh002i	1945	);
338 :
339 :	sh002i	1960	print CGI::start_Tr();
340 :			print CGI::td(); # for indentation :(
341 :			print CGI::start_td();
342 :	sh002i	1945
343 :	sh002i	1960	if ($dbLayout eq "sql") {
344 :			print CGI::p(
345 :			"The SQL settings you enter below must match the settings in the DBI source",
346 :			" specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"),
347 :			" with the course name you entered above."
348 :			);
349 :	sh002i	1945	print CGI::start_table({class=>"FormLayout"});
350 :			print CGI::Tr(
351 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
352 :			CGI::td(
353 :	sh002i	1960	CGI::textfield("add_sql_host", $add_sql_host, 25),
354 :	sh002i	1945	CGI::br(),
355 :			CGI::small("Leave blank to use the default host."),
356 :			),
357 :			);
358 :			print CGI::Tr(
359 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
360 :			CGI::td(
361 :	sh002i	1960	CGI::textfield("add_sql_port", $add_sql_port, 25),
362 :	sh002i	1945	CGI::br(),
363 :			CGI::small("Leave blank to use the default port."),
364 :			),
365 :			);
366 :			print CGI::Tr(
367 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
368 :	sh002i	1960	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
369 :	sh002i	1945	);
370 :			print CGI::Tr(
371 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
372 :	sh002i	1960	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
373 :	sh002i	1945	);
374 :			print CGI::Tr(
375 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
376 :	sh002i	1960	CGI::td(CGI::textfield("add_sql_database", $add_sql_database, 25)),
377 :	sh002i	1945	);
378 :			print CGI::Tr(
379 :			CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
380 :			CGI::td(
381 :	sh002i	1960	CGI::textfield("add_sql_wwhost", $add_sql_wwhost \|\| "localhost", 25),
382 :	sh002i	1945	CGI::br(),
383 :			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."),
384 :			),
385 :			);
386 :	sh002i	1960	print CGI::end_table();
387 :			} elsif ($dbLayout eq "gdbm") {
388 :	sh002i	1945	print CGI::start_table({class=>"FormLayout"});
389 :			print CGI::Tr(
390 :			CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
391 :	sh002i	2004	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),
392 :	sh002i	1945	);
393 :	sh002i	1960	print CGI::end_table();
394 :	sh002i	1945	}
395 :
396 :	sh002i	1960	print CGI::end_td();
397 :			print CGI::end_Tr();
398 :	sh002i	1945	print CGI::end_table();
399 :			}
400 :
401 :	sh002i	1960
402 :			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.");
403 :
404 :			print CGI::table({class=>"FormLayout"},
405 :			CGI::Tr(
406 :	sh002i	1945	CGI::th({class=>"LeftHeader"}, "Professor User ID:"),
407 :	sh002i	1960	CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID \|\| "professor", 25)),
408 :			),
409 :			CGI::Tr(
410 :			CGI::th({class=>"LeftHeader"}, "Professor Password:"),
411 :			CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
412 :			),
413 :			);
414 :
415 :			print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
416 :
417 :			print CGI::end_form();
418 :			}
419 :
420 :			sub add_course_validate {
421 :			my ($self) = @_;
422 :			my $r = $self->r;
423 :			my $ce = $r->ce;
424 :			#my $db = $r->db;
425 :			#my $authz = $r->authz;
426 :			#my $urlpath = $r->urlpath;
427 :
428 :			my $add_courseID = $r->param("add_courseID") \|\| "";
429 :			my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
430 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
431 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
432 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
433 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
434 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
435 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
436 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
437 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
438 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
439 :
440 :			my @errors;
441 :
442 :			if ($add_courseID eq "") {
443 :			push @errors, "You must specify a course name.";
444 :			}
445 :
446 :			if ($add_dbLayout eq "") {
447 :			push @errors, "You must select a database layout.";
448 :			} else {
449 :			if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
450 :			if ($add_dbLayout eq "sql") {
451 :			push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
452 :			push @errors, "You must specify the SQL admin password." if $add_sql_password eq "";
453 :			push @errors, "You must specify the SQL confirm_delete_course." if $add_sql_database eq "";
454 :			push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
455 :			} elsif ($add_dbLayout eq "gdbm") {
456 :			push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
457 :			}
458 :			} else {
459 :			push @errors, "The database layout $add_dbLayout doesn't exist.";
460 :			}
461 :			}
462 :
463 :			if ($add_initial_userID ne "") {
464 :			push @errors, "You must specify a professor password." if $add_initial_password eq "";
465 :			}
466 :
467 :			return @errors;
468 :			}
469 :
470 :			sub do_add_course {
471 :			my ($self) = @_;
472 :			my $r = $self->r;
473 :			my $ce = $r->ce;
474 :			my $db = $r->db;
475 :			#my $authz = $r->authz;
476 :			my $urlpath = $r->urlpath;
477 :
478 :			my $add_courseID = $r->param("add_courseID") \|\| "";
479 :			my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
480 :			my $add_sql_host = $r->param("add_sql_host") \|\| "";
481 :			my $add_sql_port = $r->param("add_sql_port") \|\| "";
482 :			my $add_sql_username = $r->param("add_sql_username") \|\| "";
483 :			my $add_sql_password = $r->param("add_sql_password") \|\| "";
484 :			my $add_sql_database = $r->param("add_sql_database") \|\| "";
485 :			my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
486 :			my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
487 :			my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
488 :			my $add_initial_password = $r->param("add_initial_password") \|\| "";
489 :
490 :			my $ce2 = WeBWorK::CourseEnvironment->new(
491 :			$ce->{webworkDirs}->{root},
492 :			$ce->{webworkURLs}->{root},
493 :			$ce->{pg}->{directories}->{root},
494 :			$add_courseID,
495 :			);
496 :
497 :	sh002i	2004	my %courseOptions = { dbLayoutName => $add_dbLayout };
498 :			if ($add_dbLayout eq "gdbm") {
499 :			$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
500 :			}
501 :
502 :	sh002i	1960	my %dbOptions;
503 :			if ($add_dbLayout eq "sql") {
504 :			$dbOptions{host} = $add_sql_host if $add_sql_host ne "";
505 :			$dbOptions{port} = $add_sql_port if $add_sql_port ne "";
506 :			$dbOptions{username} = $add_sql_username;
507 :			$dbOptions{password} = $add_sql_password;
508 :			$dbOptions{database} = $add_sql_database;
509 :			$dbOptions{wwhost} = $add_sql_wwhost;
510 :			}
511 :
512 :			my @users;
513 :			if ($add_initial_userID ne "") {
514 :	sh002i	2004	my $User = $db->newUser(
515 :	sh002i	1960	user_id => $add_initial_userID,
516 :			status => "C",
517 :	sh002i	2004	);
518 :			my $Password = $db->newPassword(
519 :	sh002i	1960	user_id => $add_initial_userID,
520 :			password => cryptPassword($add_initial_password),
521 :	sh002i	2004	);
522 :			my $PermissionLevel = $db->newPermissionLevel(
523 :	sh002i	1960	user_id => $add_initial_userID,
524 :			permission => "10",
525 :	sh002i	2004	);
526 :			push @users, [ $User, $Password, $PermissionLevel ];
527 :	sh002i	1960	}
528 :
529 :			eval {
530 :			addCourse(
531 :	sh002i	2004	courseID => $add_courseID,
532 :			ce => $ce2,
533 :			courseOptions => \%courseOptions,
534 :			dbOptions => \%dbOptions,
535 :			users => \@users,
536 :	sh002i	1945	);
537 :	sh002i	1960	};
538 :
539 :			if ($@) {
540 :			my $error = $@;
541 :			print CGI::div({class=>"ResultsWithError"},
542 :			CGI::p("An error occured while creating the course $add_courseID:"),
543 :			CGI::tt(CGI::escapeHTML($error)),
544 :			);
545 :			} else {
546 :			print CGI::div({class=>"ResultsWithoutError"},
547 :			CGI::p("Successfully created the course $add_courseID"),
548 :			);
549 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
550 :			courseID => $add_courseID);
551 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
552 :			print CGI::div({style=>"text-align: center"},
553 :			CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
554 :			);
555 :			}
556 :			}
557 :
558 :			################################################################################
559 :
560 :			sub delete_course_form {
561 :			my ($self) = @_;
562 :			my $r = $self->r;
563 :			my $ce = $r->ce;
564 :			#my $db = $r->db;
565 :			#my $authz = $r->authz;
566 :			#my $urlpath = $r->urlpath;
567 :
568 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
569 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
570 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
571 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
572 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
573 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
574 :
575 :			my @courseIDs = listCourses($ce);
576 :
577 :			my %courseLabels; # records... heh.
578 :			foreach my $courseID (@courseIDs) {
579 :			my $tempCE = WeBWorK::CourseEnvironment->new(
580 :			$ce->{webworkDirs}->{root},
581 :			$ce->{webworkURLs}->{root},
582 :			$ce->{pg}->{directories}->{root},
583 :			$courseID,
584 :			);
585 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
586 :			}
587 :
588 :			print CGI::h2("Delete Course");
589 :
590 :			print CGI::start_form("POST", $r->uri);
591 :			print $self->hidden_authen_fields;
592 :			print $self->hidden_fields("subDisplay");
593 :
594 :			print CGI::p("Select a course to delete.");
595 :
596 :			print CGI::table({class=>"FormLayout"},
597 :			CGI::Tr(
598 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
599 :	sh002i	1945	CGI::td(
600 :	sh002i	1960	CGI::scrolling_list(
601 :			-name => "delete_courseID",
602 :			-values => \@courseIDs,
603 :			-default => $delete_courseID,
604 :			-size => 10,
605 :			-multiple => 0,
606 :			-labels => \%courseLabels,
607 :	sh002i	1945	),
608 :			),
609 :	sh002i	1960	),
610 :			);
611 :
612 :			print CGI::p(
613 :			"If the course's database layout (indicated in parentheses above) is "
614 :			. CGI::b("sql") . ", supply the SQL connections information requested below."
615 :			);
616 :
617 :			print CGI::start_table({class=>"FormLayout"});
618 :			print CGI::Tr(
619 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
620 :			CGI::td(
621 :			CGI::textfield("delete_sql_host", $delete_sql_host, 25),
622 :			CGI::br(),
623 :			CGI::small("Leave blank to use the default host."),
624 :			),
625 :			);
626 :			print CGI::Tr(
627 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
628 :			CGI::td(
629 :			CGI::textfield("delete_sql_port", $delete_sql_port, 25),
630 :			CGI::br(),
631 :			CGI::small("Leave blank to use the default port."),
632 :			),
633 :			);
634 :			print CGI::Tr(
635 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
636 :			CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
637 :			);
638 :			print CGI::Tr(
639 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
640 :			CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
641 :			);
642 :			print CGI::Tr(
643 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
644 :			CGI::td(CGI::textfield("delete_sql_database", $delete_sql_database, 25)),
645 :			);
646 :			print CGI::end_table();
647 :
648 :			print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
649 :
650 :			print CGI::end_form();
651 :			}
652 :
653 :			sub delete_course_validate {
654 :			my ($self) = @_;
655 :			my $r = $self->r;
656 :			my $ce = $r->ce;
657 :			#my $db = $r->db;
658 :			#my $authz = $r->authz;
659 :			my $urlpath = $r->urlpath;
660 :
661 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
662 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
663 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
664 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
665 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
666 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
667 :
668 :			my @errors;
669 :
670 :			if ($delete_courseID eq "") {
671 :			push @errors, "You must specify a course name.";
672 :			} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
673 :			push @errors, "You cannot delete the course you are currently using.";
674 :			}
675 :
676 :			my $ce2 = WeBWorK::CourseEnvironment->new(
677 :			$ce->{webworkDirs}->{root},
678 :			$ce->{webworkURLs}->{root},
679 :			$ce->{pg}->{directories}->{root},
680 :			$delete_courseID,
681 :			);
682 :
683 :			if ($ce2->{dbLayoutName} eq "sql") {
684 :			push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
685 :			push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
686 :			push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
687 :			}
688 :
689 :			return @errors;
690 :			}
691 :
692 :			sub delete_course_confirm {
693 :			my ($self) = @_;
694 :			my $r = $self->r;
695 :			my $ce = $r->ce;
696 :			#my $db = $r->db;
697 :			#my $authz = $r->authz;
698 :			#my $urlpath = $r->urlpath;
699 :
700 :			print CGI::h2("Delete Course");
701 :
702 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
703 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
704 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
705 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
706 :
707 :			my $ce2 = WeBWorK::CourseEnvironment->new(
708 :			$ce->{webworkDirs}->{root},
709 :			$ce->{webworkURLs}->{root},
710 :			$ce->{pg}->{directories}->{root},
711 :			$delete_courseID,
712 :			);
713 :
714 :			if ($ce2->{dbLayoutName} eq "sql") {
715 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
716 :			. "? All course files and data and the following database will be destroyed."
717 :			. " There is no undo available.");
718 :
719 :			print CGI::table({class=>"FormLayout"},
720 :			CGI::Tr(
721 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
722 :			CGI::td($delete_sql_host \|\| "system default"),
723 :	sh002i	1945	),
724 :	sh002i	1960	CGI::Tr(
725 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
726 :			CGI::td($delete_sql_port \|\| "system default"),
727 :			),
728 :			CGI::Tr(
729 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
730 :			CGI::td($delete_sql_database),
731 :			),
732 :	sh002i	1945	);
733 :	sh002i	1960	} else {
734 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
735 :			. "? All course files and data will be destroyed. There is no undo available.");
736 :	sh002i	1945	}
737 :
738 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
739 :			print $self->hidden_authen_fields;
740 :			print $self->hidden_fields("subDisplay");
741 :			print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
742 :
743 :			print CGI::p({style=>"text-align: center"},
744 :			CGI::submit("decline_delete_course", "Don't delete"),
745 :			" ",
746 :			CGI::submit("confirm_delete_course", "Delete"),
747 :			);
748 :
749 :			print CGI::end_form();
750 :			}
751 :
752 :			sub do_delete_course {
753 :			my ($self) = @_;
754 :			my $r = $self->r;
755 :			my $ce = $r->ce;
756 :			#my $db = $r->db;
757 :			#my $authz = $r->authz;
758 :			#my $urlpath = $r->urlpath;
759 :
760 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
761 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
762 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
763 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
764 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
765 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
766 :
767 :			my $ce2 = WeBWorK::CourseEnvironment->new(
768 :			$ce->{webworkDirs}->{root},
769 :			$ce->{webworkURLs}->{root},
770 :			$ce->{pg}->{directories}->{root},
771 :			$delete_courseID,
772 :			);
773 :
774 :			my %dbOptions;
775 :			if ($ce2->{dbLayoutName} eq "sql") {
776 :			$dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
777 :			$dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
778 :			$dbOptions{username} = $delete_sql_username;
779 :			$dbOptions{password} = $delete_sql_password;
780 :			$dbOptions{database} = $delete_sql_database;
781 :			}
782 :
783 :			eval {
784 :			deleteCourse(
785 :			courseID => $delete_courseID,
786 :			ce => $ce2,
787 :			dbOptions => \%dbOptions,
788 :			);
789 :			};
790 :
791 :			if ($@) {
792 :			my $error = $@;
793 :			print CGI::div({class=>"ResultsWithError"},
794 :			CGI::p("An error occured while deleting the course $delete_courseID:"),
795 :			CGI::tt(CGI::escapeHTML($error)),
796 :			);
797 :			} else {
798 :			print CGI::div({class=>"ResultsWithoutError"},
799 :			CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),
800 :			);
801 :	sh002i	1945
802 :			print CGI::start_form("POST", $r->uri);
803 :			print $self->hidden_authen_fields;
804 :	sh002i	1960	print $self->hidden_fields("subDisplay");
805 :	sh002i	1945
806 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
807 :	sh002i	1945
808 :	sh002i	1960	print CGI::end_form();
809 :	sh002i	1945	}
810 :			}
811 :
812 :	sh002i	1985	################################################################################
813 :
814 :			sub export_database_form {
815 :			my ($self) = @_;
816 :			my $r = $self->r;
817 :			my $ce = $r->ce;
818 :			#my $db = $r->db;
819 :			#my $authz = $r->authz;
820 :			#my $urlpath = $r->urlpath;
821 :
822 :			my @tables = keys %{$ce->{dbLayout}};
823 :
824 :			my $export_courseID = $r->param("export_courseID") \|\| "";
825 :			my @export_tables = $r->param("export_tables");
826 :
827 :			@export_tables = @tables unless @export_tables;
828 :
829 :			my @courseIDs = listCourses($ce);
830 :
831 :			my %courseLabels; # records... heh.
832 :			foreach my $courseID (@courseIDs) {
833 :			my $tempCE = WeBWorK::CourseEnvironment->new(
834 :			$ce->{webworkDirs}->{root},
835 :			$ce->{webworkURLs}->{root},
836 :			$ce->{pg}->{directories}->{root},
837 :			$courseID,
838 :			);
839 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
840 :			}
841 :
842 :			print CGI::h2("Export Database");
843 :
844 :			print CGI::start_form("POST", $r->uri);
845 :			print $self->hidden_authen_fields;
846 :			print $self->hidden_fields("subDisplay");
847 :
848 :			print CGI::p("Select a course to export the course's database.");
849 :
850 :			print CGI::table({class=>"FormLayout"},
851 :			CGI::Tr(
852 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
853 :			CGI::td(
854 :			CGI::scrolling_list(
855 :			-name => "export_courseID",
856 :			-values => \@courseIDs,
857 :			-default => $export_courseID,
858 :			-size => 10,
859 :			-multiple => 0,
860 :			-labels => \%courseLabels,
861 :			),
862 :			),
863 :			),
864 :			CGI::Tr(
865 :			CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
866 :			CGI::td(
867 :			CGI::checkbox_group(
868 :			-name => "export_tables",
869 :			-values => \@tables,
870 :			-default => \@export_tables,
871 :			-linebreak => 1,
872 :			),
873 :			),
874 :			),
875 :			);
876 :
877 :			print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
878 :
879 :			print CGI::end_form();
880 :			}
881 :
882 :			sub export_database_validate {
883 :			my ($self) = @_;
884 :			my $r = $self->r;
885 :			#my $ce = $r->ce;
886 :			#my $db = $r->db;
887 :			#my $authz = $r->authz;
888 :			#my $urlpath = $r->urlpath;
889 :
890 :			my $export_courseID = $r->param("export_courseID") \|\| "";
891 :			my @export_tables = $r->param("export_tables");
892 :
893 :			my @errors;
894 :
895 :			if ($export_courseID eq "") {
896 :			push @errors, "You must specify a course name.";
897 :			}
898 :
899 :			unless (@export_tables) {
900 :			push @errors, "You must specify at least one table to export.";
901 :			}
902 :
903 :			return @errors;
904 :			}
905 :
906 :			sub do_export_database {
907 :			my ($self) = @_;
908 :			my $r = $self->r;
909 :			my $ce = $r->ce;
910 :			#my $db = $r->db;
911 :			#my $authz = $r->authz;
912 :			my $urlpath = $r->urlpath;
913 :
914 :			my $export_courseID = $r->param("export_courseID");
915 :			my @export_tables = $r->param("export_tables");
916 :
917 :			my $ce2 = WeBWorK::CourseEnvironment->new(
918 :			$ce->{webworkDirs}->{root},
919 :			$ce->{webworkURLs}->{root},
920 :			$ce->{pg}->{directories}->{root},
921 :			$export_courseID,
922 :			);
923 :
924 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
925 :
926 :			my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
927 :			my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
928 :
929 :			my @errors;
930 :
931 :			eval {
932 :			@errors = dbExport(
933 :			db => $db2,
934 :			xml => $fh,
935 :			tables => \@export_tables,
936 :			);
937 :			};
938 :
939 :			push @errors, "Fatal exception: $@" if $@;
940 :
941 :			if (@errors) {
942 :			print CGI::div({class=>"ResultsWithError"},
943 :			CGI::p("An error occured while exporting the database of course $export_courseID:"),
944 :			CGI::ul(CGI::li(\@errors)),
945 :			);
946 :			} else {
947 :			print CGI::div({class=>"ResultsWithoutError"},
948 :			CGI::p("Export succeeded."),
949 :			);
950 :
951 :			print CGI::div({style=>"text-align: center"},
952 :			CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
953 :			);
954 :			}
955 :			}
956 :
957 :			################################################################################
958 :
959 :			sub import_database_form {
960 :			my ($self) = @_;
961 :			my $r = $self->r;
962 :			my $ce = $r->ce;
963 :			#my $db = $r->db;
964 :			#my $authz = $r->authz;
965 :			#my $urlpath = $r->urlpath;
966 :
967 :			my @tables = keys %{$ce->{dbLayout}};
968 :
969 :			my $import_file = $r->param("import_file") \|\| "";
970 :			my $import_courseID = $r->param("import_courseID") \|\| "";
971 :			my @import_tables = $r->param("import_tables");
972 :			my $import_conflict = $r->param("import_conflict") \|\| "skip";
973 :
974 :			@import_tables = @tables unless @import_tables;
975 :
976 :			my @courseIDs = listCourses($ce);
977 :
978 :			my %courseLabels; # records... heh.
979 :			foreach my $courseID (@courseIDs) {
980 :			my $tempCE = WeBWorK::CourseEnvironment->new(
981 :			$ce->{webworkDirs}->{root},
982 :			$ce->{webworkURLs}->{root},
983 :			$ce->{pg}->{directories}->{root},
984 :			$courseID,
985 :			);
986 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
987 :			}
988 :
989 :			print CGI::h2("Import Database");
990 :
991 :			print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
992 :			print $self->hidden_authen_fields;
993 :			print $self->hidden_fields("subDisplay");
994 :
995 :			print CGI::table({class=>"FormLayout"},
996 :			CGI::Tr(
997 :			CGI::th({class=>"LeftHeader"}, "Database XML File:"),
998 :			CGI::td(
999 :			CGI::filefield(
1000 :			-name => "import_file",
1001 :			-size => 50,
1002 :			),
1003 :			),
1004 :			),
1005 :			CGI::Tr(
1006 :			CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1007 :			CGI::td(
1008 :			CGI::checkbox_group(
1009 :			-name => "import_tables",
1010 :			-values => \@tables,
1011 :			-default => \@import_tables,
1012 :			-linebreak => 1,
1013 :			),
1014 :			),
1015 :			),
1016 :			CGI::Tr(
1017 :			CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1018 :			CGI::td(
1019 :			CGI::scrolling_list(
1020 :			-name => "import_courseID",
1021 :			-values => \@courseIDs,
1022 :			-default => $import_courseID,
1023 :			-size => 10,
1024 :			-multiple => 0,
1025 :			-labels => \%courseLabels,
1026 :			),
1027 :			),
1028 :			),
1029 :			CGI::Tr(
1030 :			CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1031 :			CGI::td(
1032 :			CGI::radio_group(
1033 :			-name => "import_conflict",
1034 :			-values => [qw/skip replace/],
1035 :			-default => $import_conflict,
1036 :			-linebreak=>'true',
1037 :			-labels => {
1038 :			skip => "Skip duplicate records",
1039 :			replace => "Replace duplicate records",
1040 :			},
1041 :			),
1042 :			),
1043 :			),
1044 :			);
1045 :
1046 :			print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1047 :
1048 :			print CGI::end_form();
1049 :			}
1050 :
1051 :			sub import_database_validate {
1052 :			my ($self) = @_;
1053 :			my $r = $self->r;
1054 :			#my $ce = $r->ce;
1055 :			#my $db = $r->db;
1056 :			#my $authz = $r->authz;
1057 :			#my $urlpath = $r->urlpath;
1058 :
1059 :			my $import_file = $r->param("import_file") \|\| "";
1060 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1061 :			my @import_tables = $r->param("import_tables");
1062 :			#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1063 :
1064 :			my @errors;
1065 :
1066 :			if ($import_file eq "") {
1067 :			push @errors, "You must specify a database file to upload.";
1068 :			}
1069 :
1070 :			if ($import_courseID eq "") {
1071 :			push @errors, "You must specify a course name.";
1072 :			}
1073 :
1074 :			unless (@import_tables) {
1075 :			push @errors, "You must specify at least one table to import.";
1076 :			}
1077 :
1078 :			return @errors;
1079 :			}
1080 :
1081 :			sub do_import_database {
1082 :			my ($self) = @_;
1083 :			my $r = $self->r;
1084 :			my $ce = $r->ce;
1085 :			#my $db = $r->db;
1086 :			#my $authz = $r->authz;
1087 :			my $urlpath = $r->urlpath;
1088 :
1089 :			my $import_file = $r->param("import_file");
1090 :			my $import_courseID = $r->param("import_courseID");
1091 :			my @import_tables = $r->param("import_tables");
1092 :			my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
1093 :
1094 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1095 :			$ce->{webworkDirs}->{root},
1096 :			$ce->{webworkURLs}->{root},
1097 :			$ce->{pg}->{directories}->{root},
1098 :			$import_courseID,
1099 :			);
1100 :
1101 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1102 :
1103 :			# retrieve upload from upload cache
1104 :			my ($id, $hash) = split /\s+/, $import_file;
1105 :			my $upload = WeBWorK::Upload->retrieve($id, $hash,
1106 :			dir => $ce->{webworkDirs}->{uploadCache}
1107 :			);
1108 :
1109 :			my @errors;
1110 :
1111 :			eval {
1112 :			@errors = dbImport(
1113 :			db => $db2,
1114 :			xml => $upload->fileHandle,
1115 :			tables => \@import_tables,
1116 :			conflict => $import_conflict,
1117 :			);
1118 :			};
1119 :
1120 :			$upload->dispose;
1121 :
1122 :			push @errors, "Fatal exception: $@" if $@;
1123 :
1124 :			if (@errors) {
1125 :			print CGI::div({class=>"ResultsWithError"},
1126 :			CGI::p("An error occured while importing the database of course $import_courseID:"),
1127 :			CGI::ul(CGI::li(\@errors)),
1128 :			);
1129 :			} else {
1130 :			print CGI::div({class=>"ResultsWithoutError"},
1131 :			CGI::p("Import succeeded."),
1132 :			);
1133 :			}
1134 :			}
1135 :
1136 :	sh002i	1945	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9