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

Revision 1985 - (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	1985	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.2 2004/04/09 20:19:25 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	1960	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "professor", 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 :			my %dbOptions;
498 :			if ($add_dbLayout eq "sql") {
499 :			$dbOptions{host} = $add_sql_host if $add_sql_host ne "";
500 :			$dbOptions{port} = $add_sql_port if $add_sql_port ne "";
501 :			$dbOptions{username} = $add_sql_username;
502 :			$dbOptions{password} = $add_sql_password;
503 :			$dbOptions{database} = $add_sql_database;
504 :			$dbOptions{wwhost} = $add_sql_wwhost;
505 :			}
506 :
507 :			my @users;
508 :			if ($add_initial_userID ne "") {
509 :			my $User = $db->newUser(
510 :			user_id => $add_initial_userID,
511 :			status => "C",
512 :			);
513 :			my $Password = $db->newPassword(
514 :			user_id => $add_initial_userID,
515 :			password => cryptPassword($add_initial_password),
516 :			);
517 :			my $PermissionLevel = $db->newPermissionLevel(
518 :			user_id => $add_initial_userID,
519 :			permission => "10",
520 :			);
521 :			push @users, [ $User, $Password, $PermissionLevel ];
522 :			}
523 :
524 :			eval {
525 :			addCourse(
526 :			courseID => $add_courseID,
527 :			ce => $ce2,
528 :			courseOptions => { dbLayoutName => $add_dbLayout },
529 :			dbOptions => \%dbOptions,
530 :			users => \@users,
531 :	sh002i	1945	);
532 :	sh002i	1960	};
533 :
534 :			if ($@) {
535 :			my $error = $@;
536 :			print CGI::div({class=>"ResultsWithError"},
537 :			CGI::p("An error occured while creating the course $add_courseID:"),
538 :			CGI::tt(CGI::escapeHTML($error)),
539 :			);
540 :			} else {
541 :			print CGI::div({class=>"ResultsWithoutError"},
542 :			CGI::p("Successfully created the course $add_courseID"),
543 :			);
544 :			my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
545 :			courseID => $add_courseID);
546 :			my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
547 :			print CGI::div({style=>"text-align: center"},
548 :			CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
549 :			);
550 :			}
551 :			}
552 :
553 :			################################################################################
554 :
555 :			sub delete_course_form {
556 :			my ($self) = @_;
557 :			my $r = $self->r;
558 :			my $ce = $r->ce;
559 :			#my $db = $r->db;
560 :			#my $authz = $r->authz;
561 :			#my $urlpath = $r->urlpath;
562 :
563 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
564 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
565 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
566 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
567 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
568 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
569 :
570 :			my @courseIDs = listCourses($ce);
571 :
572 :			my %courseLabels; # records... heh.
573 :			foreach my $courseID (@courseIDs) {
574 :			my $tempCE = WeBWorK::CourseEnvironment->new(
575 :			$ce->{webworkDirs}->{root},
576 :			$ce->{webworkURLs}->{root},
577 :			$ce->{pg}->{directories}->{root},
578 :			$courseID,
579 :			);
580 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
581 :			}
582 :
583 :			print CGI::h2("Delete Course");
584 :
585 :			print CGI::start_form("POST", $r->uri);
586 :			print $self->hidden_authen_fields;
587 :			print $self->hidden_fields("subDisplay");
588 :
589 :			print CGI::p("Select a course to delete.");
590 :
591 :			print CGI::table({class=>"FormLayout"},
592 :			CGI::Tr(
593 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
594 :	sh002i	1945	CGI::td(
595 :	sh002i	1960	CGI::scrolling_list(
596 :			-name => "delete_courseID",
597 :			-values => \@courseIDs,
598 :			-default => $delete_courseID,
599 :			-size => 10,
600 :			-multiple => 0,
601 :			-labels => \%courseLabels,
602 :	sh002i	1945	),
603 :			),
604 :	sh002i	1960	),
605 :			);
606 :
607 :			print CGI::p(
608 :			"If the course's database layout (indicated in parentheses above) is "
609 :			. CGI::b("sql") . ", supply the SQL connections information requested below."
610 :			);
611 :
612 :			print CGI::start_table({class=>"FormLayout"});
613 :			print CGI::Tr(
614 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
615 :			CGI::td(
616 :			CGI::textfield("delete_sql_host", $delete_sql_host, 25),
617 :			CGI::br(),
618 :			CGI::small("Leave blank to use the default host."),
619 :			),
620 :			);
621 :			print CGI::Tr(
622 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
623 :			CGI::td(
624 :			CGI::textfield("delete_sql_port", $delete_sql_port, 25),
625 :			CGI::br(),
626 :			CGI::small("Leave blank to use the default port."),
627 :			),
628 :			);
629 :			print CGI::Tr(
630 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
631 :			CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
632 :			);
633 :			print CGI::Tr(
634 :			CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
635 :			CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
636 :			);
637 :			print CGI::Tr(
638 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
639 :			CGI::td(CGI::textfield("delete_sql_database", $delete_sql_database, 25)),
640 :			);
641 :			print CGI::end_table();
642 :
643 :			print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
644 :
645 :			print CGI::end_form();
646 :			}
647 :
648 :			sub delete_course_validate {
649 :			my ($self) = @_;
650 :			my $r = $self->r;
651 :			my $ce = $r->ce;
652 :			#my $db = $r->db;
653 :			#my $authz = $r->authz;
654 :			my $urlpath = $r->urlpath;
655 :
656 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
657 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
658 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
659 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
660 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
661 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
662 :
663 :			my @errors;
664 :
665 :			if ($delete_courseID eq "") {
666 :			push @errors, "You must specify a course name.";
667 :			} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
668 :			push @errors, "You cannot delete the course you are currently using.";
669 :			}
670 :
671 :			my $ce2 = WeBWorK::CourseEnvironment->new(
672 :			$ce->{webworkDirs}->{root},
673 :			$ce->{webworkURLs}->{root},
674 :			$ce->{pg}->{directories}->{root},
675 :			$delete_courseID,
676 :			);
677 :
678 :			if ($ce2->{dbLayoutName} eq "sql") {
679 :			push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
680 :			push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
681 :			push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
682 :			}
683 :
684 :			return @errors;
685 :			}
686 :
687 :			sub delete_course_confirm {
688 :			my ($self) = @_;
689 :			my $r = $self->r;
690 :			my $ce = $r->ce;
691 :			#my $db = $r->db;
692 :			#my $authz = $r->authz;
693 :			#my $urlpath = $r->urlpath;
694 :
695 :			print CGI::h2("Delete Course");
696 :
697 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
698 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
699 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
700 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
701 :
702 :			my $ce2 = WeBWorK::CourseEnvironment->new(
703 :			$ce->{webworkDirs}->{root},
704 :			$ce->{webworkURLs}->{root},
705 :			$ce->{pg}->{directories}->{root},
706 :			$delete_courseID,
707 :			);
708 :
709 :			if ($ce2->{dbLayoutName} eq "sql") {
710 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
711 :			. "? All course files and data and the following database will be destroyed."
712 :			. " There is no undo available.");
713 :
714 :			print CGI::table({class=>"FormLayout"},
715 :			CGI::Tr(
716 :			CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
717 :			CGI::td($delete_sql_host \|\| "system default"),
718 :	sh002i	1945	),
719 :	sh002i	1960	CGI::Tr(
720 :			CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
721 :			CGI::td($delete_sql_port \|\| "system default"),
722 :			),
723 :			CGI::Tr(
724 :			CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
725 :			CGI::td($delete_sql_database),
726 :			),
727 :	sh002i	1945	);
728 :	sh002i	1960	} else {
729 :			print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
730 :			. "? All course files and data will be destroyed. There is no undo available.");
731 :	sh002i	1945	}
732 :
733 :	sh002i	1960	print CGI::start_form("POST", $r->uri);
734 :			print $self->hidden_authen_fields;
735 :			print $self->hidden_fields("subDisplay");
736 :			print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
737 :
738 :			print CGI::p({style=>"text-align: center"},
739 :			CGI::submit("decline_delete_course", "Don't delete"),
740 :			" ",
741 :			CGI::submit("confirm_delete_course", "Delete"),
742 :			);
743 :
744 :			print CGI::end_form();
745 :			}
746 :
747 :			sub do_delete_course {
748 :			my ($self) = @_;
749 :			my $r = $self->r;
750 :			my $ce = $r->ce;
751 :			#my $db = $r->db;
752 :			#my $authz = $r->authz;
753 :			#my $urlpath = $r->urlpath;
754 :
755 :			my $delete_courseID = $r->param("delete_courseID") \|\| "";
756 :			my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
757 :			my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
758 :			my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
759 :			my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
760 :			my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
761 :
762 :			my $ce2 = WeBWorK::CourseEnvironment->new(
763 :			$ce->{webworkDirs}->{root},
764 :			$ce->{webworkURLs}->{root},
765 :			$ce->{pg}->{directories}->{root},
766 :			$delete_courseID,
767 :			);
768 :
769 :			my %dbOptions;
770 :			if ($ce2->{dbLayoutName} eq "sql") {
771 :			$dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
772 :			$dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
773 :			$dbOptions{username} = $delete_sql_username;
774 :			$dbOptions{password} = $delete_sql_password;
775 :			$dbOptions{database} = $delete_sql_database;
776 :			}
777 :
778 :			eval {
779 :			deleteCourse(
780 :			courseID => $delete_courseID,
781 :			ce => $ce2,
782 :			dbOptions => \%dbOptions,
783 :			);
784 :			};
785 :
786 :			if ($@) {
787 :			my $error = $@;
788 :			print CGI::div({class=>"ResultsWithError"},
789 :			CGI::p("An error occured while deleting the course $delete_courseID:"),
790 :			CGI::tt(CGI::escapeHTML($error)),
791 :			);
792 :			} else {
793 :			print CGI::div({class=>"ResultsWithoutError"},
794 :			CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),
795 :			);
796 :	sh002i	1945
797 :			print CGI::start_form("POST", $r->uri);
798 :			print $self->hidden_authen_fields;
799 :	sh002i	1960	print $self->hidden_fields("subDisplay");
800 :	sh002i	1945
801 :	sh002i	1960	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
802 :	sh002i	1945
803 :	sh002i	1960	print CGI::end_form();
804 :	sh002i	1945	}
805 :			}
806 :
807 :	sh002i	1985	################################################################################
808 :
809 :			sub export_database_form {
810 :			my ($self) = @_;
811 :			my $r = $self->r;
812 :			my $ce = $r->ce;
813 :			#my $db = $r->db;
814 :			#my $authz = $r->authz;
815 :			#my $urlpath = $r->urlpath;
816 :
817 :			my @tables = keys %{$ce->{dbLayout}};
818 :
819 :			my $export_courseID = $r->param("export_courseID") \|\| "";
820 :			my @export_tables = $r->param("export_tables");
821 :
822 :			@export_tables = @tables unless @export_tables;
823 :
824 :			my @courseIDs = listCourses($ce);
825 :
826 :			my %courseLabels; # records... heh.
827 :			foreach my $courseID (@courseIDs) {
828 :			my $tempCE = WeBWorK::CourseEnvironment->new(
829 :			$ce->{webworkDirs}->{root},
830 :			$ce->{webworkURLs}->{root},
831 :			$ce->{pg}->{directories}->{root},
832 :			$courseID,
833 :			);
834 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
835 :			}
836 :
837 :			print CGI::h2("Export Database");
838 :
839 :			print CGI::start_form("POST", $r->uri);
840 :			print $self->hidden_authen_fields;
841 :			print $self->hidden_fields("subDisplay");
842 :
843 :			print CGI::p("Select a course to export the course's database.");
844 :
845 :			print CGI::table({class=>"FormLayout"},
846 :			CGI::Tr(
847 :			CGI::th({class=>"LeftHeader"}, "Course Name:"),
848 :			CGI::td(
849 :			CGI::scrolling_list(
850 :			-name => "export_courseID",
851 :			-values => \@courseIDs,
852 :			-default => $export_courseID,
853 :			-size => 10,
854 :			-multiple => 0,
855 :			-labels => \%courseLabels,
856 :			),
857 :			),
858 :			),
859 :			CGI::Tr(
860 :			CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
861 :			CGI::td(
862 :			CGI::checkbox_group(
863 :			-name => "export_tables",
864 :			-values => \@tables,
865 :			-default => \@export_tables,
866 :			-linebreak => 1,
867 :			),
868 :			),
869 :			),
870 :			);
871 :
872 :			print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
873 :
874 :			print CGI::end_form();
875 :			}
876 :
877 :			sub export_database_validate {
878 :			my ($self) = @_;
879 :			my $r = $self->r;
880 :			#my $ce = $r->ce;
881 :			#my $db = $r->db;
882 :			#my $authz = $r->authz;
883 :			#my $urlpath = $r->urlpath;
884 :
885 :			my $export_courseID = $r->param("export_courseID") \|\| "";
886 :			my @export_tables = $r->param("export_tables");
887 :
888 :			my @errors;
889 :
890 :			if ($export_courseID eq "") {
891 :			push @errors, "You must specify a course name.";
892 :			}
893 :
894 :			unless (@export_tables) {
895 :			push @errors, "You must specify at least one table to export.";
896 :			}
897 :
898 :			return @errors;
899 :			}
900 :
901 :			sub do_export_database {
902 :			my ($self) = @_;
903 :			my $r = $self->r;
904 :			my $ce = $r->ce;
905 :			#my $db = $r->db;
906 :			#my $authz = $r->authz;
907 :			my $urlpath = $r->urlpath;
908 :
909 :			my $export_courseID = $r->param("export_courseID");
910 :			my @export_tables = $r->param("export_tables");
911 :
912 :			my $ce2 = WeBWorK::CourseEnvironment->new(
913 :			$ce->{webworkDirs}->{root},
914 :			$ce->{webworkURLs}->{root},
915 :			$ce->{pg}->{directories}->{root},
916 :			$export_courseID,
917 :			);
918 :
919 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
920 :
921 :			my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
922 :			my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
923 :
924 :			my @errors;
925 :
926 :			eval {
927 :			@errors = dbExport(
928 :			db => $db2,
929 :			xml => $fh,
930 :			tables => \@export_tables,
931 :			);
932 :			};
933 :
934 :			push @errors, "Fatal exception: $@" if $@;
935 :
936 :			if (@errors) {
937 :			print CGI::div({class=>"ResultsWithError"},
938 :			CGI::p("An error occured while exporting the database of course $export_courseID:"),
939 :			CGI::ul(CGI::li(\@errors)),
940 :			);
941 :			} else {
942 :			print CGI::div({class=>"ResultsWithoutError"},
943 :			CGI::p("Export succeeded."),
944 :			);
945 :
946 :			print CGI::div({style=>"text-align: center"},
947 :			CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
948 :			);
949 :			}
950 :			}
951 :
952 :			################################################################################
953 :
954 :			sub import_database_form {
955 :			my ($self) = @_;
956 :			my $r = $self->r;
957 :			my $ce = $r->ce;
958 :			#my $db = $r->db;
959 :			#my $authz = $r->authz;
960 :			#my $urlpath = $r->urlpath;
961 :
962 :			my @tables = keys %{$ce->{dbLayout}};
963 :
964 :			my $import_file = $r->param("import_file") \|\| "";
965 :			my $import_courseID = $r->param("import_courseID") \|\| "";
966 :			my @import_tables = $r->param("import_tables");
967 :			my $import_conflict = $r->param("import_conflict") \|\| "skip";
968 :
969 :			@import_tables = @tables unless @import_tables;
970 :
971 :			my @courseIDs = listCourses($ce);
972 :
973 :			my %courseLabels; # records... heh.
974 :			foreach my $courseID (@courseIDs) {
975 :			my $tempCE = WeBWorK::CourseEnvironment->new(
976 :			$ce->{webworkDirs}->{root},
977 :			$ce->{webworkURLs}->{root},
978 :			$ce->{pg}->{directories}->{root},
979 :			$courseID,
980 :			);
981 :			$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
982 :			}
983 :
984 :			print CGI::h2("Import Database");
985 :
986 :			print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
987 :			print $self->hidden_authen_fields;
988 :			print $self->hidden_fields("subDisplay");
989 :
990 :			print CGI::table({class=>"FormLayout"},
991 :			CGI::Tr(
992 :			CGI::th({class=>"LeftHeader"}, "Database XML File:"),
993 :			CGI::td(
994 :			CGI::filefield(
995 :			-name => "import_file",
996 :			-size => 50,
997 :			),
998 :			),
999 :			),
1000 :			CGI::Tr(
1001 :			CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1002 :			CGI::td(
1003 :			CGI::checkbox_group(
1004 :			-name => "import_tables",
1005 :			-values => \@tables,
1006 :			-default => \@import_tables,
1007 :			-linebreak => 1,
1008 :			),
1009 :			),
1010 :			),
1011 :			CGI::Tr(
1012 :			CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1013 :			CGI::td(
1014 :			CGI::scrolling_list(
1015 :			-name => "import_courseID",
1016 :			-values => \@courseIDs,
1017 :			-default => $import_courseID,
1018 :			-size => 10,
1019 :			-multiple => 0,
1020 :			-labels => \%courseLabels,
1021 :			),
1022 :			),
1023 :			),
1024 :			CGI::Tr(
1025 :			CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1026 :			CGI::td(
1027 :			CGI::radio_group(
1028 :			-name => "import_conflict",
1029 :			-values => [qw/skip replace/],
1030 :			-default => $import_conflict,
1031 :			-linebreak=>'true',
1032 :			-labels => {
1033 :			skip => "Skip duplicate records",
1034 :			replace => "Replace duplicate records",
1035 :			},
1036 :			),
1037 :			),
1038 :			),
1039 :			);
1040 :
1041 :			print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1042 :
1043 :			print CGI::end_form();
1044 :			}
1045 :
1046 :			sub import_database_validate {
1047 :			my ($self) = @_;
1048 :			my $r = $self->r;
1049 :			#my $ce = $r->ce;
1050 :			#my $db = $r->db;
1051 :			#my $authz = $r->authz;
1052 :			#my $urlpath = $r->urlpath;
1053 :
1054 :			my $import_file = $r->param("import_file") \|\| "";
1055 :			my $import_courseID = $r->param("import_courseID") \|\| "";
1056 :			my @import_tables = $r->param("import_tables");
1057 :			#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1058 :
1059 :			my @errors;
1060 :
1061 :			if ($import_file eq "") {
1062 :			push @errors, "You must specify a database file to upload.";
1063 :			}
1064 :
1065 :			if ($import_courseID eq "") {
1066 :			push @errors, "You must specify a course name.";
1067 :			}
1068 :
1069 :			unless (@import_tables) {
1070 :			push @errors, "You must specify at least one table to import.";
1071 :			}
1072 :
1073 :			return @errors;
1074 :			}
1075 :
1076 :			sub do_import_database {
1077 :			my ($self) = @_;
1078 :			my $r = $self->r;
1079 :			my $ce = $r->ce;
1080 :			#my $db = $r->db;
1081 :			#my $authz = $r->authz;
1082 :			my $urlpath = $r->urlpath;
1083 :
1084 :			my $import_file = $r->param("import_file");
1085 :			my $import_courseID = $r->param("import_courseID");
1086 :			my @import_tables = $r->param("import_tables");
1087 :			my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
1088 :
1089 :			my $ce2 = WeBWorK::CourseEnvironment->new(
1090 :			$ce->{webworkDirs}->{root},
1091 :			$ce->{webworkURLs}->{root},
1092 :			$ce->{pg}->{directories}->{root},
1093 :			$import_courseID,
1094 :			);
1095 :
1096 :			my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1097 :
1098 :			# retrieve upload from upload cache
1099 :			my ($id, $hash) = split /\s+/, $import_file;
1100 :			my $upload = WeBWorK::Upload->retrieve($id, $hash,
1101 :			dir => $ce->{webworkDirs}->{uploadCache}
1102 :			);
1103 :
1104 :			my @errors;
1105 :
1106 :			eval {
1107 :			@errors = dbImport(
1108 :			db => $db2,
1109 :			xml => $upload->fileHandle,
1110 :			tables => \@import_tables,
1111 :			conflict => $import_conflict,
1112 :			);
1113 :			};
1114 :
1115 :			$upload->dispose;
1116 :
1117 :			push @errors, "Fatal exception: $@" if $@;
1118 :
1119 :			if (@errors) {
1120 :			print CGI::div({class=>"ResultsWithError"},
1121 :			CGI::p("An error occured while importing the database of course $import_courseID:"),
1122 :			CGI::ul(CGI::li(\@errors)),
1123 :			);
1124 :			} else {
1125 :			print CGI::div({class=>"ResultsWithoutError"},
1126 :			CGI::p("Import succeeded."),
1127 :			);
1128 :			}
1129 :			}
1130 :
1131 :	sh002i	1945	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9