Diff of /branches/rel-2-4-patches/webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

Revision 2479		Revision 4136
1	################################################################################	1	################################################################################
2	# WeBWorK Online Homework Delivery System	2	# WeBWorK Online Homework Delivery System
3	# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/	3	# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.23 2004/07/10 16:06:59 sh002i Exp $	4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.46 2006/06/15 14:48:19 gage Exp $
5	#	5	#
6	# This program is free software; you can redistribute it and/or modify it under	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	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	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.	9	# version, or (b) the "Artistic License" which comes with this package.
…		…
23		23
24	=cut	24	=cut
25		25
26	use strict;	26	use strict;
27	use warnings;	27	use warnings;
28	use CGI::Pretty qw();	28	use CGI qw();
29	use Data::Dumper;	29	use Data::Dumper;
30	use File::Temp qw/tempfile/;	30	use File::Temp qw/tempfile/;
31	use WeBWorK::CourseEnvironment;	31	use WeBWorK::CourseEnvironment;
		32	use IO::File;
		33	use WeBWorK::Debug;
32	use WeBWorK::Utils qw(cryptPassword writeLog);	34	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
33	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);	35	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
		36	listArchivedCourses unarchiveCourse);
34	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);	37	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
35		38
36	sub pre_header_initialize {	39	sub pre_header_initialize {
37	my ($self) = @_;	40	my ($self) = @_;
38	my $r = $self->r;	41	my $r = $self->r;
…		…
46	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {	49	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47	$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );	50	$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48	return;	51	return;
49	}	52	}
50		53
		54	# get result and send to message
		55	my $status_message = $r->param("status_message");
		56	$self->addmessage(CGI::p("$status_message")) if $status_message;
		57
51	## if the user is asking for the downloaded database...	58	## if the user is asking for the downloaded database...
52	#if (defined $r->param("download_exported_database")) {	59	#if (defined $r->param("download_exported_database")) {
53	# my $courseID = $r->param("export_courseID");	60	# my $courseID = $r->param("export_courseID");
54	# my $random_chars = $r->param("download_exported_database");	61	# my $random_chars = $r->param("download_exported_database");
55	#	62	#
…		…
80	} else {	87	} else {
81	$method_to_call = "do_add_course";	88	$method_to_call = "do_add_course";
82	}	89	}
83	} else {	90	} else {
84	$method_to_call = "add_course_form";	91	$method_to_call = "add_course_form";
		92	}
		93	}
		94
		95	elsif ($subDisplay eq "rename_course") {
		96	if (defined $r->param("rename_course")) {
		97	@errors = $self->rename_course_validate;
		98	if (@errors) {
		99	$method_to_call = "rename_course_form";
		100	} else {
		101	$method_to_call = "do_rename_course";
		102	}
		103	} else {
		104	$method_to_call = "rename_course_form";
85	}	105	}
86	}	106	}
87		107
88	elsif ($subDisplay eq "delete_course") {	108	elsif ($subDisplay eq "delete_course") {
89	if (defined $r->param("delete_course")) {	109	if (defined $r->param("delete_course")) {
…		…
136	} else {	156	} else {
137	$method_to_call = "import_database_form";	157	$method_to_call = "import_database_form";
138	}	158	}
139	}	159	}
140		160
		161	elsif ($subDisplay eq "archive_course") {
		162	if (defined $r->param("archive_course")) {
		163	# validate or confirm
		164	@errors = $self->archive_course_validate;
		165	if (@errors) {
		166	$method_to_call = "archive_course_form";
		167	} else {
		168	$method_to_call = "archive_course_confirm";
		169	}
		170	} elsif (defined $r->param("confirm_archive_course")) {
		171	# validate and archive
		172	@errors = $self->archive_course_validate;
		173	if (@errors) {
		174	$method_to_call = "archive_course_form";
		175	} else {
		176	$method_to_call = "do_archive_course";
		177	}
		178	} else {
		179	# form only
		180	$method_to_call = "archive_course_form";
		181	}
		182	}
		183	elsif ($subDisplay eq "unarchive_course") {
		184	if (defined $r->param("unarchive_course")) {
		185	# validate or confirm
		186	@errors = $self->unarchive_course_validate;
		187	if (@errors) {
		188	$method_to_call = "unarchive_course_form";
		189	} else {
		190	$method_to_call = "unarchive_course_confirm";
		191	}
		192	} elsif (defined $r->param("confirm_unarchive_course")) {
		193	# validate and archive
		194	@errors = $self->unarchive_course_validate;
		195	if (@errors) {
		196	$method_to_call = "unarchive_course_form";
		197	} else {
		198	$method_to_call = "do_unarchive_course";
		199	}
		200	} else {
		201	# form only
		202	$method_to_call = "unarchive_course_form";
		203	}
		204	}
141	else {	205	else {
142	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";	206	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
143	}	207	}
144		208
145	}	209	}
…		…
149	}	213	}
150		214
151	sub header {	215	sub header {
152	my ($self) = @_;	216	my ($self) = @_;
153	my $method_to_call = $self->{method_to_call};	217	my $method_to_call = $self->{method_to_call};
154	if (defined $method_to_call and $method_to_call eq "do_export_database") {	218	# if (defined $method_to_call and $method_to_call eq "do_export_database") {
155	my $r = $self->r;	219	# my $r = $self->r;
156	my $courseID = $r->param("export_courseID");	220	# my $courseID = $r->param("export_courseID");
157	$r->content_type("application/octet-stream");	221	# $r->content_type("application/octet-stream");
158	$r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");	222	# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
159	$r->send_http_header;	223	# $r->send_http_header;
160	} else {	224	# } else {
161	$self->SUPER::header;	225	$self->SUPER::header;
162	}	226	# }
163	}	227	}
164		228
165	# sends:	229	# sends:
166	#	230	#
167	# HTTP/1.1 200 OK	231	# HTTP/1.1 200 OK
…		…
173		237
174	sub content {	238	sub content {
175	my ($self) = @_;	239	my ($self) = @_;
176	my $method_to_call = $self->{method_to_call};	240	my $method_to_call = $self->{method_to_call};
177	if (defined $method_to_call and $method_to_call eq "do_export_database") {	241	if (defined $method_to_call and $method_to_call eq "do_export_database") {
178	print "<!-- Áª£¢°¤¦¥»¼Ï·«¨ ´¬ö¿¹Œ§¶Ä©úÆûÂ½ÅÃº÷µ -->\n";
179	print "<!-- Those were some high-bit characters to convince Safari that we really do want this saved as a file. -->\n";
180	$self->do_export_database;	242	#$self->do_export_database;
		243	$self->SUPER::content;
181	} else {	244	} else {
182	$self->SUPER::content;	245	$self->SUPER::content;
183	}	246	}
184	}	247	}
185		248
…		…
195		258
196	# check permissions	259	# check permissions
197	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {	260	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
198	return "";	261	return "";
199	}	262	}
		263	my $method_to_call = $self->{method_to_call};
		264	my $methodMessage ="";
		265
		266	(defined($method_to_call) and $method_to_call eq "do_export_database") && do {
		267	my @export_courseID = $r->param("export_courseID");
		268	my $course_ids = join(", ", @export_courseID);
		269	$methodMessage = CGI::p("Exporting database for course(s) $course_ids").
		270	CGI::p(".... please wait....
		271	If your browser times out you will
		272	still be able to download the exported database using the
		273	file manager.").CGI::hr();
		274	};
		275
200		276
201	print CGI::p({style=>"text-align: center"},	277	print CGI::p({style=>"text-align: center"},
		278	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
		279	add_dbLayout=>'sql_single',
		280	add_templates_course => $ce->{siteDefaults}->{default_templates_course} \|\|""}
		281	)},
		282	"Add Course"
		283	),
		284	" \| ",
202	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),	285	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
203	" \| ",	286	" \| ",
204	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),	287	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
205	" \| ",	288	" \| ",
206	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),	289	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
207	" \| ",	290	" \| ",
208	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),	291	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
		292	" \| ",
		293	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
		294	"\|",
		295	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"),
		296	CGI::hr(),
		297	$methodMessage,
		298
209	);	299	);
210		300
211	print CGI::hr();	301	print CGI::p("The ability to import and to export databases is still under development.
		302	It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
		303	use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
		304	Please send bug reports if you find errors. ");
212		305
213	my @errors = @{$self->{errors}};	306	my @errors = @{$self->{errors}};
214	my $method_to_call = $self->{method_to_call};	307
215		308
216	if (@errors) {	309	if (@errors) {
217	print CGI::div({class=>"ResultsWithError"},	310	print CGI::div({class=>"ResultsWithError"},
218	CGI::p("Please correct the following errors and try again:"),	311	CGI::p("Please correct the following errors and try again:"),
219	CGI::ul(CGI::li(\@errors)),	312	CGI::ul(CGI::li(\@errors)),
220	);	313	);
221	}	314	}
222		315
223	if (defined $method_to_call and $method_to_call ne "") {	316	if (defined $method_to_call and $method_to_call ne "") {
224	$self->$method_to_call;	317	$self->$method_to_call;
		318	} else {
		319
		320	print CGI::h2("Courses");
		321
		322	print CGI::start_ol();
		323
		324	my @courseIDs = listCourses($ce);
		325	foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
		326	next if $courseID eq "admin"; # done already above
		327	my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
		328	my $tempCE = WeBWorK::CourseEnvironment->new(
		329	$ce->{webworkDirs}->{root},
		330	$ce->{webworkURLs}->{root},
		331	$ce->{pg}->{directories}->{root},
		332	$courseID,
		333	);
		334	print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
		335	CGI::code(
		336	$tempCE->{dbLayoutName},
		337	),
		338	(-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"),
		339
		340	);
		341
225	}	342	}
226		343
		344	print CGI::end_ol();
		345
		346	print CGI::h2("Archived Courses");
		347	print CGI::start_ol();
		348
		349	@courseIDs = listArchivedCourses($ce);
		350	foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
		351	print CGI::li($courseID),
		352	}
		353
		354	print CGI::end_ol();
		355	}
227	return "";	356	return "";
228	}	357	}
229		358
230	################################################################################	359	################################################################################
231		360
…		…
259	my $add_sql_password = $r->param("add_sql_password") \|\| "";	388	my $add_sql_password = $r->param("add_sql_password") \|\| "";
260	my $add_sql_database = $r->param("add_sql_database") \|\| "";	389	my $add_sql_database = $r->param("add_sql_database") \|\| "";
261	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	390	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
262	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	391	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
263		392
264	my @dbLayouts = sort keys %{ $ce->{dbLayouts} };	393	my @dbLayouts = do {
		394	my @ordered_layouts;
		395	foreach my $layout (@{$ce->{dbLayout_order}}) {
		396	if (exists $ce->{dbLayouts}->{$layout}) {
		397	push @ordered_layouts, $layout;
		398	}
		399	}
		400
		401	my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
		402	my @other_layouts;
		403	foreach my $layout (keys %{ $ce->{dbLayouts} }) {
		404	unless (exists $ordered_layouts{$layout}) {
		405	push @other_layouts, $layout;
		406	}
		407	}
		408
		409	(@ordered_layouts, @other_layouts);
		410	};
265		411
266	my $ce2 = WeBWorK::CourseEnvironment->new(	412	my $ce2 = WeBWorK::CourseEnvironment->new(
267	$ce->{webworkDirs}->{root},	413	$ce->{webworkDirs}->{root},
268	$ce->{webworkURLs}->{root},	414	$ce->{webworkURLs}->{root},
269	$ce->{pg}->{directories}->{root},	415	$ce->{pg}->{directories}->{root},
270	"COURSENAME",	416	"COURSENAME",
271	);	417	);
272		418
273	my $dbi_source = do {
274	# find the most common SQL source (stolen from CourseManagement.pm)
275	my %sources;
276	foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
277	$sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
278	}
279	my $source;
280	if (keys %sources > 1) {
281	foreach my $curr (keys %sources) {
282	$source = $curr if not defined $source or
283	$sources{$curr} > $sources{$source};
284	}
285	} else {
286	($source) = keys %sources;
287	}
288	$source;
289	};
290
291	my @existingCourses = listCourses($ce);	419	my @existingCourses = listCourses($ce);
292	@existingCourses = sort @existingCourses;	420	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
293		421
294	print CGI::h2("Add Course");	422	print CGI::h2("Add Course");
295		423
296	print CGI::start_form("POST", $r->uri);	424	print CGI::start_form("POST", $r->uri);
297	print $self->hidden_authen_fields;	425	print $self->hidden_authen_fields;
…		…
313	CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),	441	CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
314	),	442	),
315	);	443	);
316		444
317	print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");	445	print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
318		446	my $checked = ($add_admin_users) ?"checked": ""; # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
319	print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course"));	447	print CGI::p(CGI::input({-type=>'checkbox', -name=>"add_admin_users", $checked=>'' }, "Add WeBWorK administrators to new course"));
320		448
321	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only numbers, letters, hyphens, and underscores.");	449	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only
		450	numbers, letters, hyphens, periods (dots), commas,and underscores.\n");
322		451
323	print CGI::table({class=>"FormLayout"}, CGI::Tr(	452	print CGI::table({class=>"FormLayout"}, CGI::Tr(
324	CGI::td(	453	CGI::td(
325	CGI::table({class=>"FormLayout"},	454	CGI::table({class=>"FormLayout"},
326	CGI::Tr(	455	CGI::Tr(
…		…
378	print CGI::p("Select a database layout below.");	507	print CGI::p("Select a database layout below.");
379		508
380	foreach my $dbLayout (@dbLayouts) {	509	foreach my $dbLayout (@dbLayouts) {
381	print CGI::start_table({class=>"FormLayout"});	510	print CGI::start_table({class=>"FormLayout"});
382		511
		512	my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
		513	? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
		514	: $dbLayout;
		515
383	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm	516	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
384	print CGI::Tr(	517	print CGI::Tr(
385	CGI::td({style=>"text-align: right"},	518	CGI::td({style=>"text-align: right"},
386	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'	519	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
387	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',	520	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
388	),	521	),
389	CGI::td($dbLayout),	522	CGI::td($dbLayoutLabel),
390	);
391
392	print CGI::start_Tr();
393	print CGI::td(); # for indentation :(
394	print CGI::start_td();
395
396	if ($dbLayout eq "sql") {
397	print CGI::start_table({class=>"FormLayout"});
398	print CGI::Tr(CGI::td({colspan=>2},
399	"Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
400	)
401	);	523	);
402	print CGI::Tr(
403	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
404	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
405	);
406	print CGI::Tr(
407	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
408	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
409	);
410		524
411	print CGI::Tr(CGI::td({colspan=>2},
412	"The optionial SQL settings you enter below must match the settings in the DBI source"
413	. " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
414	. " with the course name you entered above."
415	)
416	);
417	print CGI::Tr(
418	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
419	CGI::td(
420	CGI::textfield("add_sql_host", $add_sql_host, 25),
421	CGI::br(),
422	CGI::small("Leave blank to use the default host."),
423	),
424	);
425	print CGI::Tr(
426	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
427	CGI::td(
428	CGI::textfield("add_sql_port", $add_sql_port, 25),
429	CGI::br(),
430	CGI::small("Leave blank to use the default port."),
431	),
432	);
433
434	print CGI::Tr(
435	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
436	CGI::td(
437	CGI::textfield("add_sql_database", $add_sql_database, 25),
438	CGI::br(),
439	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
440	),
441	);
442	print CGI::Tr(
443	CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
444	CGI::td(
445	CGI::textfield("add_sql_wwhost", $add_sql_wwhost \|\| "localhost", 25),
446	CGI::br(),
447	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."),
448	),
449	);
450	print CGI::end_table();
451	} elsif ($dbLayout eq "gdbm") {
452	print CGI::start_table({class=>"FormLayout"});
453	print CGI::Tr(
454	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
455	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),
456	);
457	print CGI::end_table();
458	}
459
460	print CGI::end_td();
461	print CGI::end_Tr();
462	print CGI::end_table();	525	print CGI::end_table();
463	}	526	}
464		527
465	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));	528	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
466		529
…		…
501		564
502	my @errors;	565	my @errors;
503		566
504	if ($add_courseID eq "") {	567	if ($add_courseID eq "") {
505	push @errors, "You must specify a course ID.";	568	push @errors, "You must specify a course ID.";
		569	}
		570	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
		571	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
506	}	572	}
507	if (grep { $add_courseID eq $_ } listCourses($ce)) {	573	if (grep { $add_courseID eq $_ } listCourses($ce)) {
508	push @errors, "A course with ID $add_courseID already exists.";	574	push @errors, "A course with ID $add_courseID already exists.";
509	}	575	}
510	if ($add_courseTitle eq "") {	576	if ($add_courseTitle eq "") {
…		…
556	sub do_add_course {	622	sub do_add_course {
557	my ($self) = @_;	623	my ($self) = @_;
558	my $r = $self->r;	624	my $r = $self->r;
559	my $ce = $r->ce;	625	my $ce = $r->ce;
560	my $db = $r->db;	626	my $db = $r->db;
561	#my $authz = $r->authz;	627	my $authz = $r->authz;
562	my $urlpath = $r->urlpath;	628	my $urlpath = $r->urlpath;
563		629
564	my $add_courseID = $r->param("add_courseID") \|\| "";	630	my $add_courseID = $r->param("add_courseID") \|\| "";
565	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";	631	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
566	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";	632	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
…		…
594		660
595	my %courseOptions = ( dbLayoutName => $add_dbLayout );	661	my %courseOptions = ( dbLayoutName => $add_dbLayout );
596		662
597	if ($add_initial_email ne "") {	663	if ($add_initial_email ne "") {
598	$courseOptions{allowedRecipients} = [ $add_initial_email ];	664	$courseOptions{allowedRecipients} = [ $add_initial_email ];
		665	# don't set feedbackRecipients -- this just gets in the way of the more
		666	# intelligent "receive_recipients" method.
599	$courseOptions{feedbackRecipients} = [ $add_initial_email ];	667	#$courseOptions{feedbackRecipients} = [ $add_initial_email ];
600	}	668	}
601		669
602	if ($add_dbLayout eq "gdbm") {	670	if ($add_dbLayout eq "gdbm") {
603	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";	671	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
604	}	672	}
…		…
616	my @users;	684	my @users;
617		685
618	# copy users from current (admin) course if desired	686	# copy users from current (admin) course if desired
619	if ($add_admin_users ne "") {	687	if ($add_admin_users ne "") {
620	foreach my $userID ($db->listUsers) {	688	foreach my $userID ($db->listUsers) {
		689	if ($userID eq $add_initial_userID) {
		690	$self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
		691	next;
		692	}
621	my $User = $db->getUser($userID);	693	my $User = $db->getUser($userID);
622	my $Password = $db->getPassword($userID);	694	my $Password = $db->getPassword($userID);
623	my $PermissionLevel = $db->getPermissionLevel($userID);	695	my $PermissionLevel = $db->getPermissionLevel($userID);
624	push @users, [ $User, $Password, $PermissionLevel ];	696	push @users, [ $User, $Password, $PermissionLevel ]
		697	if $authz->hasPermissions($userID,"create_and_delete_courses");
		698	#only transfer the "instructors" in the admin course classlist.
625	}	699	}
626	}	700	}
627		701
628	# add initial instructor if desired	702	# add initial instructor if desired
629	if ($add_initial_userID ne "") {	703	if ($add_initial_userID ne "") {
…		…
644	permission => "10",	718	permission => "10",
645	);	719	);
646	push @users, [ $User, $Password, $PermissionLevel ];	720	push @users, [ $User, $Password, $PermissionLevel ];
647	}	721	}
648		722
649	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users;	723	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
650		724
651	my %optional_arguments;	725	my %optional_arguments;
652	if ($add_templates_course ne "") {	726	if ($add_templates_course ne "") {
653	$optional_arguments{templatesFrom} = $add_templates_course;	727	$optional_arguments{templatesFrom} = $add_templates_course;
654	}	728	}
…		…
691	$add_initial_lastName,	765	$add_initial_lastName,
692	$add_initial_email,	766	$add_initial_email,
693	));	767	));
694	# add contact to admin course as student?	768	# add contact to admin course as student?
695	# FIXME -- should we do this?	769	# FIXME -- should we do this?
		770	if ($add_initial_userID ne "") {
		771	my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact
		772	my $User = $db->newUser(
		773	user_id => $composite_id, # student id includes school name and contact
		774	first_name => $add_initial_firstName,
		775	last_name => $add_initial_lastName,
		776	student_id => $add_initial_userID,
		777	email_address => $add_initial_email,
		778	status => "C",
		779	);
		780	my $Password = $db->newPassword(
		781	user_id => $composite_id,
		782	password => cryptPassword($add_initial_password),
		783	);
		784	my $PermissionLevel = $db->newPermissionLevel(
		785	user_id => $composite_id,
		786	permission => "0",
		787	);
		788	# add contact to admin course as student
		789	# or if this contact and course already exist in a dropped status
		790	# change the student's status to enrolled
		791	if (my $oldUser = $db->getUser($composite_id) ) {
		792	warn "Replacing old data for $composite_id status: ". $oldUser->status;
		793	$db->deleteUser($composite_id);
		794	}
		795	eval { $db->addUser($User) }; warn $@ if $@;
		796	eval { $db->addPassword($Password) }; warn $@ if $@;
		797	eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@;
		798	}
696	print CGI::div({class=>"ResultsWithoutError"},	799	print CGI::div({class=>"ResultsWithoutError"},
697	CGI::p("Successfully created the course $add_courseID"),	800	CGI::p("Successfully created the course $add_courseID"),
698	);	801	);
699	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",	802	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
700	courseID => $add_courseID);	803	courseID => $add_courseID);
…		…
703	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),	806	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
704	);	807	);
705	}	808	}
706		809
707		810
		811	}
		812
		813	################################################################################
		814
		815	sub rename_course_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 $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		824	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		825
		826	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		827	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		828	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		829	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		830	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		831	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		832	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		833
		834	my @courseIDs = listCourses($ce);
		835	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
		836
		837	my %courseLabels; # records... heh.
		838	foreach my $courseID (@courseIDs) {
		839	my $tempCE = WeBWorK::CourseEnvironment->new(
		840	$ce->{webworkDirs}->{root},
		841	$ce->{webworkURLs}->{root},
		842	$ce->{pg}->{directories}->{root},
		843	$courseID,
		844	);
		845	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		846	}
		847
		848	print CGI::h2("Rename Course");
		849
		850	print CGI::start_form("POST", $r->uri);
		851	print $self->hidden_authen_fields;
		852	print $self->hidden_fields("subDisplay");
		853
		854	print CGI::p("Select a course to rename.");
		855
		856	print CGI::table({class=>"FormLayout"},
		857	CGI::Tr(
		858	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		859	CGI::td(
		860	CGI::scrolling_list(
		861	-name => "rename_oldCourseID",
		862	-values => \@courseIDs,
		863	-default => $rename_oldCourseID,
		864	-size => 10,
		865	-multiple => 0,
		866	-labels => \%courseLabels,
		867	),
		868	),
		869	),
		870	CGI::Tr(
		871	CGI::th({class=>"LeftHeader"}, "New Name:"),
		872	CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
		873	),
		874	);
		875
		876	print CGI::p(
		877	"If the course's database layout (indicated in parentheses above) is "
		878	. CGI::b("sql") . ", supply the SQL connections information requested below."
		879	);
		880
		881	print CGI::start_table({class=>"FormLayout"});
		882	print CGI::Tr(CGI::td({colspan=>2},
		883	"Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
		884	)
		885	);
		886	print CGI::Tr(
		887	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		888	CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
		889	);
		890	print CGI::Tr(
		891	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		892	CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
		893	);
		894
		895	print CGI::Tr(
		896	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
		897	CGI::td(
		898	CGI::textfield("rename_sql_host", $rename_sql_host, 25),
		899	CGI::br(),
		900	CGI::small("Leave blank to use the default host."),
		901	),
		902	);
		903	print CGI::Tr(
		904	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
		905	CGI::td(
		906	CGI::textfield("rename_sql_port", $rename_sql_port, 25),
		907	CGI::br(),
		908	CGI::small("Leave blank to use the default port."),
		909	),
		910	);
		911
		912	print CGI::Tr(
		913	CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
		914	CGI::td(
		915	CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
		916	CGI::br(),
		917	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
		918	),
		919	);
		920	print CGI::Tr(
		921	CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
		922	CGI::td(
		923	CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
		924	CGI::br(),
		925	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
		926	),
		927	);
		928	print CGI::Tr(
		929	CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
		930	CGI::td(
		931	CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost \|\| "localhost", 25),
		932	CGI::br(),
		933	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."),
		934	),
		935	);
		936	print CGI::end_table();
		937
		938	print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
		939
		940	print CGI::end_form();
		941	}
		942
		943	sub rename_course_validate {
		944	my ($self) = @_;
		945	my $r = $self->r;
		946	my $ce = $r->ce;
		947	#my $db = $r->db;
		948	#my $authz = $r->authz;
		949	#my $urlpath = $r->urlpath;
		950
		951	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		952	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		953
		954	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		955	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		956	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		957	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		958	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		959	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		960	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		961
		962	my @errors;
		963
		964	if ($rename_oldCourseID eq "") {
		965	push @errors, "You must select a course to rename.";
		966	}
		967	if ($rename_newCourseID eq "") {
		968	push @errors, "You must specify a new name for the course.";
		969	}
		970	if ($rename_oldCourseID eq $rename_newCourseID) {
		971	push @errors, "Can't rename to the same name.";
		972	}
		973	unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
		974	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
		975	}
		976	if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
		977	push @errors, "A course with ID $rename_newCourseID already exists.";
		978	}
		979
		980	my $ce2 = WeBWorK::CourseEnvironment->new(
		981	$ce->{webworkDirs}->{root},
		982	$ce->{webworkURLs}->{root},
		983	$ce->{pg}->{directories}->{root},
		984	$rename_oldCourseID,
		985	);
		986
		987	if ($ce2->{dbLayoutName} eq "sql") {
		988	push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
		989	#push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
		990	#push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
		991	#push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
		992	}
		993
		994	return @errors;
		995	}
		996
		997	sub do_rename_course {
		998	my ($self) = @_;
		999	my $r = $self->r;
		1000	my $ce = $r->ce;
		1001	my $db = $r->db;
		1002	#my $authz = $r->authz;
		1003	my $urlpath = $r->urlpath;
		1004
		1005	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		1006	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		1007
		1008	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		1009	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		1010	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		1011	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		1012	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		1013	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		1014	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		1015
		1016	my $ce2 = WeBWorK::CourseEnvironment->new(
		1017	$ce->{webworkDirs}->{root},
		1018	$ce->{webworkURLs}->{root},
		1019	$ce->{pg}->{directories}->{root},
		1020	$rename_oldCourseID,
		1021	);
		1022
		1023	my $dbLayoutName = $ce->{dbLayoutName};
		1024
		1025	my %dbOptions;
		1026	if ($dbLayoutName eq "sql") {
		1027	$dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
		1028	$dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
		1029	$dbOptions{username} = $rename_sql_username;
		1030	$dbOptions{password} = $rename_sql_password;
		1031	$dbOptions{old_database} = $rename_sql_oldDatabase \|\| "webwork_$rename_oldCourseID";
		1032	$dbOptions{new_database} = $rename_sql_newDatabase \|\| "webwork_$rename_newCourseID";
		1033	$dbOptions{wwhost} = $rename_sql_wwhost;
		1034	}
		1035
		1036	eval {
		1037	renameCourse(
		1038	courseID => $rename_oldCourseID,
		1039	ce => $ce2,
		1040	dbOptions => \%dbOptions,
		1041	newCourseID => $rename_newCourseID,
		1042	);
		1043	};
		1044	if ($@) {
		1045	my $error = $@;
		1046	print CGI::div({class=>"ResultsWithError"},
		1047	CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
		1048	CGI::tt(CGI::escapeHTML($error)),
		1049	);
		1050	} else {
		1051	print CGI::div({class=>"ResultsWithoutError"},
		1052	CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
		1053	);
		1054	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
		1055	courseID => $rename_newCourseID);
		1056	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
		1057	print CGI::div({style=>"text-align: center"},
		1058	CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
		1059	);
		1060	}
708	}	1061	}
709		1062
710	################################################################################	1063	################################################################################
711		1064
712	sub delete_course_form {	1065	sub delete_course_form {
…		…
723	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";	1076	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
724	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";	1077	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
725	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";	1078	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
726		1079
727	my @courseIDs = listCourses($ce);	1080	my @courseIDs = listCourses($ce);
728	@courseIDs = sort @courseIDs;	1081	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
729		1082
730	my %courseLabels; # records... heh.	1083	my %courseLabels; # records... heh.
731	foreach my $courseID (@courseIDs) {	1084	foreach my $courseID (@courseIDs) {
732	my $tempCE = WeBWorK::CourseEnvironment->new(	1085	my $tempCE = WeBWorK::CourseEnvironment->new(
733	$ce->{webworkDirs}->{root},	1086	$ce->{webworkDirs}->{root},
…		…
766	"If the course's database layout (indicated in parentheses above) is "	1119	"If the course's database layout (indicated in parentheses above) is "
767	. CGI::b("sql") . ", supply the SQL connections information requested below."	1120	. CGI::b("sql") . ", supply the SQL connections information requested below."
768	);	1121	);
769		1122
770	print CGI::start_table({class=>"FormLayout"});	1123	print CGI::start_table({class=>"FormLayout"});
		1124	print CGI::Tr(CGI::td({colspan=>2},
		1125	"Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database."
		1126	)
		1127	);
		1128	print CGI::Tr(
		1129	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		1130	CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
		1131	);
		1132	print CGI::Tr(
		1133	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		1134	CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
		1135	);
		1136
		1137	#print CGI::Tr(CGI::td({colspan=>2},
		1138	# "The optionial SQL settings you enter below must match the settings in the DBI source"
		1139	# . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
		1140	# . " with the course name you entered above."
		1141	# )
		1142	#);
771	print CGI::Tr(	1143	print CGI::Tr(
772	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),	1144	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
773	CGI::td(	1145	CGI::td(
774	CGI::textfield("delete_sql_host", $delete_sql_host, 25),	1146	CGI::textfield("delete_sql_host", $delete_sql_host, 25),
775	CGI::br(),	1147	CGI::br(),
…		…
782	CGI::textfield("delete_sql_port", $delete_sql_port, 25),	1154	CGI::textfield("delete_sql_port", $delete_sql_port, 25),
783	CGI::br(),	1155	CGI::br(),
784	CGI::small("Leave blank to use the default port."),	1156	CGI::small("Leave blank to use the default port."),
785	),	1157	),
786	);	1158	);
787	print CGI::Tr(	1159
788	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
789	CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
790	);
791	print CGI::Tr(
792	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
793	CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
794	);
795	print CGI::Tr(	1160	print CGI::Tr(
796	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),	1161	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
797	CGI::td(	1162	CGI::td(
798	CGI::textfield("delete_sql_database", $delete_sql_database, 25),	1163	CGI::textfield("delete_sql_database", $delete_sql_database, 25),
799	CGI::br(),	1164	CGI::br(),
…		…
908		1273
909	sub do_delete_course {	1274	sub do_delete_course {
910	my ($self) = @_;	1275	my ($self) = @_;
911	my $r = $self->r;	1276	my $r = $self->r;
912	my $ce = $r->ce;	1277	my $ce = $r->ce;
913	#my $db = $r->db;	1278	my $db = $r->db;
914	#my $authz = $r->authz;	1279	#my $authz = $r->authz;
915	#my $urlpath = $r->urlpath;	1280	#my $urlpath = $r->urlpath;
916		1281
917	my $delete_courseID = $r->param("delete_courseID") \|\| "";	1282	my $delete_courseID = $r->param("delete_courseID") \|\| "";
918	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";	1283	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
…		…
950	print CGI::div({class=>"ResultsWithError"},	1315	print CGI::div({class=>"ResultsWithError"},
951	CGI::p("An error occured while deleting the course $delete_courseID:"),	1316	CGI::p("An error occured while deleting the course $delete_courseID:"),
952	CGI::tt(CGI::escapeHTML($error)),	1317	CGI::tt(CGI::escapeHTML($error)),
953	);	1318	);
954	} else {	1319	} else {
		1320	# mark the contact person in the admin course as dropped.
		1321	# find the contact person for the course by searching the admin classlist.
		1322	my @contacts = grep /_$delete_courseID$/, $db->listUsers;
		1323	die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1;
		1324	#warn "contacts", join(" ", @contacts);
		1325	#my $composite_id = "${add_initial_userID}_${add_courseID}";
		1326	my $composite_id = $contacts[0];
		1327
		1328	# mark the contact person as dropped.
		1329	my $User = $db->getUser($composite_id);
		1330	my $status_name = 'Drop';
		1331	my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
		1332	$User->status($status_value);
		1333	$db->putUser($User);
		1334
955	print CGI::div({class=>"ResultsWithoutError"},	1335	print CGI::div({class=>"ResultsWithoutError"},
956	CGI::p("Successfully deleted the course $delete_courseID."),	1336	CGI::p("Successfully deleted the course $delete_courseID."),
957	);	1337	);
958	writeLog($ce, "hosted_courses", join("\t",	1338	writeLog($ce, "hosted_courses", join("\t",
959	"\tDeleted",	1339	"\tDeleted",
…		…
983		1363
984	my @tables = keys %{$ce->{dbLayout}};	1364	my @tables = keys %{$ce->{dbLayout}};
985		1365
986	my $export_courseID = $r->param("export_courseID") \|\| "";	1366	my $export_courseID = $r->param("export_courseID") \|\| "";
987	my @export_tables = $r->param("export_tables");	1367	my @export_tables = $r->param("export_tables");
988		1368
989	@export_tables = @tables unless @export_tables;	1369	@export_tables = @tables unless @export_tables;
990		1370
991	my @courseIDs = listCourses($ce);	1371	my @courseIDs = listCourses($ce);
992	@courseIDs = sort @courseIDs;	1372	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
993		1373
994	my %courseLabels; # records... heh.	1374	my %courseLabels; # records... heh.
995	foreach my $courseID (@courseIDs) {	1375	foreach my $courseID (@courseIDs) {
996	my $tempCE = WeBWorK::CourseEnvironment->new(	1376	my $tempCE = WeBWorK::CourseEnvironment->new(
997	$ce->{webworkDirs}->{root},	1377	$ce->{webworkDirs}->{root},
…		…
1006		1386
1007	print CGI::start_form("GET", $r->uri);	1387	print CGI::start_form("GET", $r->uri);
1008	print $self->hidden_authen_fields;	1388	print $self->hidden_authen_fields;
1009	print $self->hidden_fields("subDisplay");	1389	print $self->hidden_fields("subDisplay");
1010		1390
1011	print CGI::p("Select a course to export the course's database.");	1391	print CGI::p("Select a course to export the course's database. Please note
		1392	that exporting can take a very long time for a large course. If you have
		1393	shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
		1394	utility instead.");
1012		1395
1013	print CGI::table({class=>"FormLayout"},	1396	print CGI::table({class=>"FormLayout"},
1014	CGI::Tr(	1397	CGI::Tr(
1015	CGI::th({class=>"LeftHeader"}, "Course Name:"),	1398	CGI::th({class=>"LeftHeader"}, "Course Name:"),
1016	CGI::td(	1399	CGI::td(
1017	CGI::scrolling_list(	1400	CGI::scrolling_list(
1018	-name => "export_courseID",	1401	-name => "export_courseID",
1019	-values => \@courseIDs,	1402	-values => \@courseIDs,
1020	-default => $export_courseID,	1403	-default => $export_courseID,
1021	-size => 10,	1404	-size => 10,
1022	-multiple => 0,	1405	-multiple => 1,
1023	-labels => \%courseLabels,	1406	-labels => \%courseLabels,
1024	),	1407	),
1025	),	1408	),
1026	),	1409	),
1027	CGI::Tr(	1410	CGI::Tr(
…		…
1048	#my $ce = $r->ce;	1431	#my $ce = $r->ce;
1049	#my $db = $r->db;	1432	#my $db = $r->db;
1050	#my $authz = $r->authz;	1433	#my $authz = $r->authz;
1051	#my $urlpath = $r->urlpath;	1434	#my $urlpath = $r->urlpath;
1052		1435
1053	my $export_courseID = $r->param("export_courseID") \|\| "";	1436	my @export_courseID = $r->param("export_courseID") \|\| ();
1054	my @export_tables = $r->param("export_tables");	1437	my @export_tables = $r->param("export_tables");
1055		1438
1056	my @errors;	1439	my @errors;
1057		1440
1058	if ($export_courseID eq "") {	1441	unless ( @export_courseID) {
1059	push @errors, "You must specify a course name.";	1442	push @errors, "You must specify at least one course name.";
1060	}	1443	}
1061		1444
1062	unless (@export_tables) {	1445	unless (@export_tables) {
1063	push @errors, "You must specify at least one table to export.";	1446	push @errors, "You must specify at least one table to export.";
1064	}	1447	}
…		…
1072	my $ce = $r->ce;	1455	my $ce = $r->ce;
1073	#my $db = $r->db;	1456	#my $db = $r->db;
1074	#my $authz = $r->authz;	1457	#my $authz = $r->authz;
1075	my $urlpath = $r->urlpath;	1458	my $urlpath = $r->urlpath;
1076		1459
1077	my $export_courseID = $r->param("export_courseID");	1460	my @export_courseID = $r->param("export_courseID");
1078	my @export_tables = $r->param("export_tables");	1461	my @export_tables = $r->param("export_tables");
1079		1462
		1463	foreach my $export_courseID (@export_courseID) {
		1464
1080	my $ce2 = WeBWorK::CourseEnvironment->new(	1465	my $ce2 = WeBWorK::CourseEnvironment->new(
1081	$ce->{webworkDirs}->{root},	1466	$ce->{webworkDirs}->{root},
1082	$ce->{webworkURLs}->{root},	1467	$ce->{webworkURLs}->{root},
1083	$ce->{pg}->{directories}->{root},	1468	$ce->{pg}->{directories}->{root},
1084	$export_courseID,	1469	$export_courseID,
1085	);	1470	);
1086		1471
1087	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1472	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1088		1473
1089	#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});	1474	#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1090	#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;	1475	#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
		1476	# export to the admin/templates directory
		1477	my $exportFileName = "$export_courseID.exported.xml";
		1478	my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
		1479	# get a unique name
		1480	my $number =1;
		1481	while (-e "$exportFilePath.$number.gz") {
		1482	$number++;
		1483	last if $number>9;
		1484	}
		1485	if ($number<=9 ) {
		1486	$exportFilePath = "$exportFilePath.$number";
		1487	$exportFileName = "$exportFileName.$number";
		1488	} else {
		1489	$self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
		1490	remove some of these files."));
		1491	$exportFilePath = "$exportFilePath.999";
		1492	$exportFileName = "$exportFileName.999";
		1493	}
1091		1494
		1495	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
		1496
1092	my @errors;	1497	my @errors;
1093
1094	eval {	1498	eval {
1095	@errors = dbExport(	1499	@errors = dbExport(
1096	db => $db2,	1500	db => $db2,
1097	#xml => $fh,	1501	#xml => $fh,
1098	xml => *STDOUT,	1502	xml => $outputFileHandle,
1099	tables => \@export_tables,	1503	tables => \@export_tables,
1100	);	1504	);
1101	};	1505	};
		1506
		1507	$outputFileHandle->close();
1102		1508
		1509	my $gzipMessage = system( 'gzip', $exportFilePath);
		1510	if ( !$gzipMessage ) {
		1511	$self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
		1512	You may download it with the file manager."));
		1513	} else {
		1514	$self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
		1515	}
		1516	unlink $exportFilePath;
		1517	} # end export of one course
1103	#push @errors, "Fatal exception: $@" if $@;	1518	#push @errors, "Fatal exception: $@" if $@;
1104	#	1519	#
1105	#if (@errors) {	1520	#if (@errors) {
1106	# print CGI::div({class=>"ResultsWithError"},	1521	# print CGI::div({class=>"ResultsWithError"},
1107	# CGI::p("An error occured while exporting the database of course $export_courseID:"),	1522	# CGI::p("An error occured while exporting the database of course $export_courseID:"),
…		…
1136	my $import_conflict = $r->param("import_conflict") \|\| "skip";	1551	my $import_conflict = $r->param("import_conflict") \|\| "skip";
1137		1552
1138	@import_tables = @tables unless @import_tables;	1553	@import_tables = @tables unless @import_tables;
1139		1554
1140	my @courseIDs = listCourses($ce);	1555	my @courseIDs = listCourses($ce);
1141	@courseIDs = sort @courseIDs;	1556	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1142		1557
1143		1558
1144	my %courseLabels; # records... heh.	1559	my %courseLabels; # records... heh.
1145	foreach my $courseID (@courseIDs) {	1560	foreach my $courseID (@courseIDs) {
1146	my $tempCE = WeBWorK::CourseEnvironment->new(	1561	my $tempCE = WeBWorK::CourseEnvironment->new(
…		…
1150	$courseID,	1565	$courseID,
1151	);	1566	);
1152	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1567	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1153	}	1568	}
1154		1569
		1570	# find databases:
		1571	my $templatesDir = $ce->{courseDirs}->{templates};
		1572	my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
		1573	my $exempt_dirs = join("\|", keys %probLibs);
		1574
		1575	my @databaseFiles = listFilesRecursive(
		1576	$templatesDir,
		1577	qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
		1578	qr/^(?:$exempt_dirs\|CVS)$/, # prune these directories
		1579	0, # match against file name only
		1580	1, # prune against path relative to $templatesDir
		1581	);
		1582
		1583	my %databaseLabels = map { ($_ => $_) } @databaseFiles;
		1584
		1585	#######
		1586
1155	print CGI::h2("Import Database");	1587	print CGI::h2("Import Database");
1156		1588
1157	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);	1589	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1158	print $self->hidden_authen_fields;	1590	print $self->hidden_authen_fields;
1159	print $self->hidden_fields("subDisplay");	1591	print $self->hidden_fields("subDisplay");
1160		1592
1161	print CGI::table({class=>"FormLayout"},	1593	print CGI::table({class=>"FormLayout"},
1162	CGI::Tr(	1594	CGI::Tr(
1163	CGI::th({class=>"LeftHeader"}, "Database XML File:"),	1595	CGI::th({class=>"LeftHeader"}, "Database XML File:"),
		1596	# CGI::td(
		1597	# CGI::filefield(
		1598	# -name => "import_file",
		1599	# -size => 50,
		1600	# ),
		1601	# ),
1164	CGI::td(	1602	CGI::td(
1165	CGI::filefield(	1603	CGI::scrolling_list(
1166	-name => "import_file",	1604	-name => "import_file",
		1605	-values => \@databaseFiles,
		1606	-default => undef,
1167	-size => 50,	1607	-size => 10,
		1608	-multiple => 0,
		1609	-labels => \%databaseLabels,
1168	),	1610	),
		1611
1169	),	1612	)
1170	),	1613	),
1171	CGI::Tr(	1614	CGI::Tr(
1172	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),	1615	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1173	CGI::td(	1616	CGI::td(
1174	CGI::checkbox_group(	1617	CGI::checkbox_group(
…		…
1228	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked	1671	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1229		1672
1230	my @errors;	1673	my @errors;
1231		1674
1232	if ($import_file eq "") {	1675	if ($import_file eq "") {
1233	push @errors, "You must specify a database file to upload.";	1676	push @errors, "You must specify a database file to import.";
1234	}	1677	}
1235		1678
1236	if ($import_courseID eq "") {	1679	if ($import_courseID eq "") {
1237	push @errors, "You must specify a course name.";	1680	push @errors, "You must specify a course name.";
1238	}	1681	}
…		…
1264	$import_courseID,	1707	$import_courseID,
1265	);	1708	);
1266		1709
1267	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1710	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1268		1711
		1712	# locate file
		1713	my $templateDir = $ce->{courseDirs}->{templates};
		1714	my $filePath = "$templateDir/$import_file";
		1715
		1716	my $gunzipMessage = system( 'gunzip', $filePath);
		1717	#FIXME
		1718	#warn "gunzip ", $gunzipMessage;
		1719	$filePath =~ s/\.gz$//;
		1720	#warn "new file path is $filePath";
		1721	my $fileHandle = new IO::File("<$filePath");
1269	# retrieve upload from upload cache	1722	# retrieve upload from upload cache
1270	my ($id, $hash) = split /\s+/, $import_file;	1723	# my ($id, $hash) = split /\s+/, $import_file;
1271	my $upload = WeBWorK::Upload->retrieve($id, $hash,	1724	# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1272	dir => $ce->{webworkDirs}->{uploadCache}	1725	# dir => $ce->{webworkDirs}->{uploadCache}
1273	);	1726	# );
1274		1727
1275	my @errors;	1728	my @errors;
1276		1729
1277	eval {	1730	eval {
1278	@errors = dbImport(	1731	@errors = dbImport(
1279	db => $db2,	1732	db => $db2,
1280	xml => $upload->fileHandle,	1733	# xml => $upload->fileHandle,
		1734	xml => $fileHandle,
1281	tables => \@import_tables,	1735	tables => \@import_tables,
1282	conflict => $import_conflict,	1736	conflict => $import_conflict,
1283	);	1737	);
1284	};	1738	};
1285		1739
1286	$upload->dispose;
1287
1288	push @errors, "Fatal exception: $@" if $@;	1740	push @errors, "Fatal exception: $@" if $@;
		1741	push @errors, $gunzipMessage if $gunzipMessage;
1289		1742
1290	if (@errors) {	1743	if (@errors) {
1291	print CGI::div({class=>"ResultsWithError"},	1744	print CGI::div({class=>"ResultsWithError"},
1292	CGI::p("An error occured while importing the database of course $import_courseID:"),	1745	CGI::p("An error occured while importing the database of course $import_courseID:"),
1293	CGI::ul(CGI::li(\@errors)),	1746	CGI::ul(CGI::li(\@errors)),
…		…
1296	print CGI::div({class=>"ResultsWithoutError"},	1749	print CGI::div({class=>"ResultsWithoutError"},
1297	CGI::p("Import succeeded."),	1750	CGI::p("Import succeeded."),
1298	);	1751	);
1299	}	1752	}
1300	}	1753	}
		1754	##########################################################################
		1755	sub archive_course_form {
		1756	my ($self) = @_;
		1757	my $r = $self->r;
		1758	my $ce = $r->ce;
		1759	#my $db = $r->db;
		1760	#my $authz = $r->authz;
		1761	#my $urlpath = $r->urlpath;
		1762
		1763	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1764	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1765	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1766	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1767	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1768	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1769
		1770	my @courseIDs = listCourses($ce);
		1771	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		1772
		1773	my %courseLabels; # records... heh.
		1774	foreach my $courseID (@courseIDs) {
		1775	my $tempCE = WeBWorK::CourseEnvironment->new(
		1776	$ce->{webworkDirs}->{root},
		1777	$ce->{webworkURLs}->{root},
		1778	$ce->{pg}->{directories}->{root},
		1779	$courseID,
		1780	);
		1781	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		1782	}
		1783
		1784	print CGI::h2("archive Course");
		1785
		1786	print CGI::start_form("POST", $r->uri);
		1787	print $self->hidden_authen_fields;
		1788	print $self->hidden_fields("subDisplay");
		1789
		1790	print CGI::p("Select a course to archive.");
		1791
		1792	print CGI::table({class=>"FormLayout"},
		1793	CGI::Tr(
		1794	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		1795	CGI::td(
		1796	CGI::scrolling_list(
		1797	-name => "archive_courseID",
		1798	-values => \@courseIDs,
		1799	-default => $archive_courseID,
		1800	-size => 10,
		1801	-multiple => 0,
		1802	-labels => \%courseLabels,
		1803	),
		1804	),
		1805
		1806	),
		1807	CGI::Tr(
		1808	CGI::th({class=>"LeftHeader"}, "Delete course:"),
		1809	CGI::td({-style=>'color:red'}, CGI::checkbox({
		1810	-name=>'delete_course',
		1811	-checked=>0,
		1812	-value => 1,
		1813	-label =>'Delete course after archiving. Caution there is no undo!',
		1814	},
		1815	),
		1816	),
		1817	)
		1818	);
		1819
		1820	print CGI::p(
		1821	"Currently the archive facility is only available for mysql databases.
		1822	It depends on the mysqldump application."
		1823	);
1301		1824
		1825
		1826	print CGI::p({style=>"text-align: center"}, CGI::submit("archive_course", "archive Course"));
		1827
		1828	print CGI::end_form();
		1829	}
		1830
		1831	sub archive_course_validate {
		1832	my ($self) = @_;
		1833	my $r = $self->r;
		1834	my $ce = $r->ce;
		1835	#my $db = $r->db;
		1836	#my $authz = $r->authz;
		1837	my $urlpath = $r->urlpath;
		1838
		1839	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1840	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1841	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1842	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1843	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1844	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1845
		1846	my @errors;
		1847
		1848	if ($archive_courseID eq "") {
		1849	push @errors, "You must specify a course name.";
		1850	} elsif ($archive_courseID eq $urlpath->arg("courseID")) {
		1851	push @errors, "You cannot archive the course you are currently using.";
		1852	}
		1853
		1854	my $ce2 = WeBWorK::CourseEnvironment->new(
		1855	$ce->{webworkDirs}->{root},
		1856	$ce->{webworkURLs}->{root},
		1857	$ce->{pg}->{directories}->{root},
		1858	$archive_courseID,
		1859	);
		1860
		1861	if ($ce2->{dbLayoutName} eq "sql") {
		1862	push @errors, "You must specify the SQL admin username." if $archive_sql_username eq "";
		1863	#push @errors, "You must specify the SQL admin password." if $archive_sql_password eq "";
		1864	#push @errors, "You must specify the SQL database name." if $archive_sql_database eq "";
		1865	}
		1866
		1867	return @errors;
		1868	}
		1869
		1870	sub archive_course_confirm {
		1871	my ($self) = @_;
		1872	my $r = $self->r;
		1873	my $ce = $r->ce;
		1874	#my $db = $r->db;
		1875	#my $authz = $r->authz;
		1876	#my $urlpath = $r->urlpath;
		1877
		1878	print CGI::h2("archive Course");
		1879
		1880	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1881	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1882	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1883	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1884	my $delete_course_flag = $r->param("delete_course") \|\| "";
		1885	my $ce2 = WeBWorK::CourseEnvironment->new(
		1886	$ce->{webworkDirs}->{root},
		1887	$ce->{webworkURLs}->{root},
		1888	$ce->{pg}->{directories}->{root},
		1889	$archive_courseID,
		1890	);
		1891
		1892	if ($ce2->{dbLayoutName} ) {
		1893	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
		1894	. "? ");
		1895	print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ".
		1896	CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag;
		1897
		1898
		1899	}
		1900
		1901	print CGI::start_form("POST", $r->uri);
		1902	print $self->hidden_authen_fields;
		1903	print $self->hidden_fields("subDisplay");
		1904	print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database delete_course/);
		1905
		1906	print CGI::p({style=>"text-align: center"},
		1907	CGI::submit("decline_archive_course", "Don't archive"),
		1908	" ",
		1909	CGI::submit("confirm_archive_course", "archive"),
		1910	);
		1911
		1912	print CGI::end_form();
		1913	}
		1914
		1915	sub do_archive_course {
		1916	my ($self) = @_;
		1917	my $r = $self->r;
		1918	my $ce = $r->ce;
		1919	my $db = $r->db;
		1920	#my $authz = $r->authz;
		1921	#my $urlpath = $r->urlpath;
		1922
		1923	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1924	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1925	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1926	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1927	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1928	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1929	my $delete_course_flag = $r->param("delete_course") \|\| "";
		1930
		1931	my $ce2 = WeBWorK::CourseEnvironment->new(
		1932	$ce->{webworkDirs}->{root},
		1933	$ce->{webworkURLs}->{root},
		1934	$ce->{pg}->{directories}->{root},
		1935	$archive_courseID,
		1936	);
		1937
		1938	my %dbOptions;
		1939	if ($ce2->{dbLayoutName} eq "sql") {
		1940	$dbOptions{host} = $archive_sql_host if $archive_sql_host ne "";
		1941	$dbOptions{port} = $archive_sql_port if $archive_sql_port ne "";
		1942	$dbOptions{username} = $archive_sql_username;
		1943	$dbOptions{password} = $archive_sql_password;
		1944	$dbOptions{database} = $archive_sql_database \|\| "webwork_$archive_courseID";
		1945	}
		1946
		1947	eval {
		1948	archiveCourse(
		1949	courseID => $archive_courseID,
		1950	ce => $ce2,
		1951	dbOptions => \%dbOptions,
		1952	);
		1953	};
		1954
		1955	if ($@) {
		1956	my $error = $@;
		1957	print CGI::div({class=>"ResultsWithError"},
		1958	CGI::p("An error occured while archiving the course $archive_courseID:"),
		1959	CGI::tt(CGI::escapeHTML($error)),
		1960	);
		1961	} else {
		1962	print CGI::div({class=>"ResultsWithoutError"},
		1963	CGI::p("Successfully archived the course $archive_courseID"),
		1964	);
		1965	writeLog($ce, "hosted_courses", join("\t",
		1966	"\tarchived",
		1967	"",
		1968	"",
		1969	$archive_courseID,
		1970	));
		1971
		1972	if ($delete_course_flag) {
		1973	eval {
		1974	deleteCourse(
		1975	courseID => $archive_courseID,
		1976	ce => $ce2,
		1977	dbOptions => \%dbOptions,
		1978	);
		1979	};
		1980
		1981	if ($@) {
		1982	my $error = $@;
		1983	print CGI::div({class=>"ResultsWithError"},
		1984	CGI::p("An error occured while deleting the course $archive_courseID:"),
		1985	CGI::tt(CGI::escapeHTML($error)),
		1986	);
		1987	} else {
		1988	# mark the contact person in the admin course as dropped.
		1989	# find the contact person for the course by searching the admin classlist.
		1990	my @contacts = grep /_$archive_courseID$/, $db->listUsers;
		1991	die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1;
		1992	#warn "contacts", join(" ", @contacts);
		1993	#my $composite_id = "${add_initial_userID}_${add_courseID}";
		1994	my $composite_id = $contacts[0];
		1995
		1996	# mark the contact person as dropped.
		1997	my $User = $db->getUser($composite_id);
		1998	my $status_name = 'Drop';
		1999	my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
		2000	$User->status($status_value);
		2001	$db->putUser($User);
		2002
		2003	print CGI::div({class=>"ResultsWithoutError"},
		2004	CGI::p("Successfully deleted the course $archive_courseID."),
		2005	);
		2006	}
		2007
		2008
		2009	}
		2010
		2011	# print CGI::start_form("POST", $r->uri);
		2012	# print $self->hidden_authen_fields;
		2013	# print $self->hidden_fields("subDisplay");
		2014	#
		2015	# print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),);
		2016	#
		2017	# print CGI::end_form();
		2018	}
		2019	}
		2020	##########################################################################
		2021	sub unarchive_course_form {
		2022	my ($self) = @_;
		2023	my $r = $self->r;
		2024	my $ce = $r->ce;
		2025	#my $db = $r->db;
		2026	#my $authz = $r->authz;
		2027	#my $urlpath = $r->urlpath;
		2028
		2029	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		2030	my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
		2031	my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
		2032	my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
		2033	my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
		2034	my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
		2035
		2036	# First find courses which have been archived.
		2037	my @courseIDs = listArchivedCourses($ce);
		2038	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		2039
		2040	my %courseLabels; # records... heh.
		2041	foreach my $courseID (@courseIDs) {
		2042	$courseLabels{$courseID} = $courseID;
		2043	}
		2044
		2045	print CGI::h2("Unarchive Course -- not yet operational");
		2046
		2047	print CGI::start_form("POST", $r->uri);
		2048	print $self->hidden_authen_fields;
		2049	print $self->hidden_fields("subDisplay");
		2050
		2051	print CGI::p("Select a course to unarchive.");
		2052
		2053	print CGI::table({class=>"FormLayout"},
		2054	CGI::Tr(
		2055	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		2056	CGI::td(
		2057	CGI::scrolling_list(
		2058	-name => "unarchive_courseID",
		2059	-values => \@courseIDs,
		2060	-default => $unarchive_courseID,
		2061	-size => 10,
		2062	-multiple => 0,
		2063	-labels => \%courseLabels,
		2064	),
		2065	),
		2066	),
		2067	);
		2068
		2069	print CGI::p(
		2070	"Currently the unarchive facility is only available for mysql databases.
		2071	It depends on the mysqldump application."
		2072	);
		2073
		2074
		2075	print CGI::p({style=>"text-align: center"}, CGI::submit("unarchive_course", "Unarchive Course"));
		2076
		2077	print CGI::end_form();
		2078	}
		2079
		2080	sub unarchive_course_validate {
		2081	my ($self) = @_;
		2082	my $r = $self->r;
		2083	my $ce = $r->ce;
		2084	#my $db = $r->db;
		2085	#my $authz = $r->authz;
		2086	my $urlpath = $r->urlpath;
		2087
		2088	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		2089	my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
		2090	my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
		2091	my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
		2092	my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
		2093	my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
		2094
		2095	my @errors;
		2096
		2097	my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
		2098
		2099	if ($new_courseID eq "") {
		2100	push @errors, "You must specify a course name.";
		2101	} elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) {
		2102	#Check that a directory for this course doesn't already exist
		2103	push @errors, "A directory already exists with the name $new_courseID.
		2104	You must first delete this existing course before you can unarchive.";
		2105	}
		2106
		2107
		2108
		2109	return @errors;
		2110	}
		2111
		2112	sub unarchive_course_confirm {
		2113	my ($self) = @_;
		2114	my $r = $self->r;
		2115	my $ce = $r->ce;
		2116	#my $db = $r->db;
		2117	#my $authz = $r->authz;
		2118	#my $urlpath = $r->urlpath;
		2119
		2120	print CGI::h2("Unarchive Course");
		2121
		2122	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		2123	my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
		2124	my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
		2125	my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
		2126
		2127	my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
		2128
		2129
		2130
		2131	print CGI::start_form("POST", $r->uri);
		2132	print CGI::p($unarchive_courseID," to course ",
		2133	CGI::input({-name=>'new_courseID', -value=>$new_courseID})
		2134	);
		2135
		2136	print $self->hidden_authen_fields;
		2137	print $self->hidden_fields("subDisplay");
		2138	print $self->hidden_fields(qw/unarchive_courseID
		2139	unarchive_sql_host
		2140	unarchive_sql_port
		2141	unarchive_sql_username
		2142	unarchive_sql_password
		2143	unarchive_sql_database/);
		2144
		2145	print CGI::p({style=>"text-align: center"},
		2146	CGI::submit("decline_unarchive_course", "Don't unarchive"),
		2147	" ",
		2148	CGI::submit("confirm_unarchive_course", "unarchive"),
		2149	);
		2150
		2151	print CGI::end_form();
		2152	}
		2153
		2154	sub do_unarchive_course {
		2155	my ($self) = @_;
		2156	my $r = $self->r;
		2157	my $ce = $r->ce;
		2158	#my $db = $r->db;
		2159	#my $authz = $r->authz;
		2160	my $urlpath = $r->urlpath;
		2161	my $new_courseID = $r->param("new_courseID") \|\| "";
		2162	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		2163	my $unarchive_sql_host = $r->param("unarchive_sql_host") \|\| "";
		2164	my $unarchive_sql_port = $r->param("unarchive_sql_port") \|\| "";
		2165	my $unarchive_sql_username = $r->param("unarchive_sql_username") \|\| "";
		2166	my $unarchive_sql_password = $r->param("unarchive_sql_password") \|\| "";
		2167	my $unarchive_sql_database = $r->param("unarchive_sql_database") \|\| "";
		2168
		2169
		2170	my %dbOptions;
		2171
		2172	eval {
		2173	unarchiveCourse(
		2174	courseID => $new_courseID,
		2175	archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID",
		2176	ce => $ce , # $ce2,
		2177	dbOptions => undef,
		2178	);
		2179	};
		2180
		2181	if ($@) {
		2182	my $error = $@;
		2183	print CGI::div({class=>"ResultsWithError"},
		2184	CGI::p("An error occured while archiving the course $unarchive_courseID:"),
		2185	CGI::tt(CGI::escapeHTML($error)),
		2186	);
		2187	} else {
		2188	print CGI::div({class=>"ResultsWithoutError"},
		2189	CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"),
		2190	);
		2191	writeLog($ce, "hosted_courses", join("\t",
		2192	"\tunarchived",
		2193	"",
		2194	"",
		2195	"$unarchive_courseID to $new_courseID",
		2196	));
		2197
		2198	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
		2199	courseID => $new_courseID);
		2200	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
		2201	print CGI::div({style=>"text-align: center"},
		2202	CGI::a({href=>$newCourseURL}, "Log into $new_courseID"),
		2203	);
		2204	# print CGI::start_form("POST", $r->uri);
		2205	# print $self->hidden_authen_fields;
		2206	# print $self->hidden_fields("subDisplay");
		2207	#
		2208	# print CGI::p({style=>"text-align: center"}, CGI::submit("decline_unarchive_course", "OK"),);
		2209	#
		2210	# print CGI::end_form();
		2211	}
		2212	}
		2213
		2214	################################################################################
1302	1;	2215	1;

 Legend:



Removed from v.2479
 


changed lines


 
Added in v.4136
 Legend:



Removed from v.2479
 


changed lines


 
Added in v.4136
-Removed from v.2479
+Added in v.4136

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9