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

Revision 2299		Revision 4357
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.16 2004/06/06 00:20:14 gage Exp $	4	# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.55 2006/07/28 02:13:25 sh002i 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(-nosticky );
		29	use WeBWorK::CGI;
29	use Data::Dumper;	30	use Data::Dumper;
30	use File::Temp qw/tempfile/;	31	use File::Temp qw/tempfile/;
31	use WeBWorK::CourseEnvironment;	32	use WeBWorK::CourseEnvironment;
		33	use IO::File;
		34	use WeBWorK::Debug;
32	use WeBWorK::Utils qw(cryptPassword writeLog);	35	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
33	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);	36	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
		37	listArchivedCourses unarchiveCourse);
34	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);	38	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
		39
		40	use constant IMPORT_EXPORT_WARNING => "The ability to import and export
		41	databases is still under development. It seems to work but it is <b>VERY</b>
		42	slow on large courses. You may prefer to use webwork2/bin/wwdb or the mysql
		43	dump facility for archiving large courses. Please send bug reports if you find
		44	errors.";
35		45
36	sub pre_header_initialize {	46	sub pre_header_initialize {
37	my ($self) = @_;	47	my ($self) = @_;
38	my $r = $self->r;	48	my $r = $self->r;
39	my $ce = $r->ce;	49	my $ce = $r->ce;
…		…
45	# check permissions	55	# check permissions
46	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {	56	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47	$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );	57	$self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48	return;	58	return;
49	}	59	}
		60
		61	# get result and send to message
		62	my $status_message = $r->param("status_message");
		63	$self->addmessage(CGI::p("$status_message")) if $status_message;
50		64
		65	## if the user is asking for the downloaded database...
51	if (defined $r->param("download_exported_database")) {	66	#if (defined $r->param("download_exported_database")) {
52	my $courseID = $r->param("export_courseID");	67	# my $courseID = $r->param("export_courseID");
53	my $random_chars = $r->param("download_exported_database");	68	# my $random_chars = $r->param("download_exported_database");
54		69	#
55	die "courseID not specified" unless defined $courseID;	70	# die "courseID not specified" unless defined $courseID;
56	die "invalid file specification" unless $random_chars =~ m/^\w+$/;	71	# die "invalid file specification" unless $random_chars =~ m/^\w+$/;
57		72	#
58	my $tempdir = $ce->{webworkDirs}->{tmp};	73	# my $tempdir = $ce->{webworkDirs}->{tmp};
59	my $export_file = "$tempdir/db_export_$random_chars";	74	# my $export_file = "$tempdir/db_export_$random_chars";
60		75	#
61	$self->reply_with_file("text/xml", $export_file, "${courseID}_database.xml", 0);	76	# $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0);
		77	#
		78	# return "";
		79	#}
		80	#
		81	## otherwise...
		82
		83	my @errors;
		84	my $method_to_call;
		85
		86	my $subDisplay = $r->param("subDisplay");
		87	if (defined $subDisplay) {
		88
		89	if ($subDisplay eq "add_course") {
		90	if (defined $r->param("add_course")) {
		91	@errors = $self->add_course_validate;
		92	if (@errors) {
		93	$method_to_call = "add_course_form";
		94	} else {
		95	$method_to_call = "do_add_course";
		96	}
		97	} else {
		98	$method_to_call = "add_course_form";
		99	}
		100	}
		101
		102	elsif ($subDisplay eq "rename_course") {
		103	if (defined $r->param("rename_course")) {
		104	@errors = $self->rename_course_validate;
		105	if (@errors) {
		106	$method_to_call = "rename_course_form";
		107	} else {
		108	$method_to_call = "do_rename_course";
		109	}
		110	} else {
		111	$method_to_call = "rename_course_form";
		112	}
		113	}
		114
		115	elsif ($subDisplay eq "delete_course") {
		116	if (defined $r->param("delete_course")) {
		117	# validate or confirm
		118	@errors = $self->delete_course_validate;
		119	if (@errors) {
		120	$method_to_call = "delete_course_form";
		121	} else {
		122	$method_to_call = "delete_course_confirm";
		123	}
		124	} elsif (defined $r->param("confirm_delete_course")) {
		125	# validate and delete
		126	@errors = $self->delete_course_validate;
		127	if (@errors) {
		128	$method_to_call = "delete_course_form";
		129	} else {
		130	$method_to_call = "do_delete_course";
		131	}
		132	} else {
		133	# form only
		134	$method_to_call = "delete_course_form";
		135	}
		136	}
		137
		138	elsif ($subDisplay eq "export_database") {
		139	if (defined $r->param("export_database")) {
		140	@errors = $self->export_database_validate;
		141	if (@errors) {
		142	$method_to_call = "export_database_form";
		143	} else {
		144	# we have to do something special here, since we're sending
		145	# the database as we export it. $method_to_call still gets
		146	# set here, but it gets caught by header() and content()
		147	# below instead of by body().
		148	$method_to_call = "do_export_database";
		149	}
		150	} else {
		151	$method_to_call = "export_database_form";
		152	}
		153	}
		154
		155	elsif ($subDisplay eq "import_database") {
		156	if (defined $r->param("import_database")) {
		157	@errors = $self->import_database_validate;
		158	if (@errors) {
		159	$method_to_call = "import_database_form";
		160	} else {
		161	$method_to_call = "do_import_database";
		162	}
		163	} else {
		164	$method_to_call = "import_database_form";
		165	}
		166	}
		167
		168	elsif ($subDisplay eq "archive_course") {
		169	if (defined $r->param("archive_course")) {
		170	# validate or confirm
		171	@errors = $self->archive_course_validate;
		172	if (@errors) {
		173	$method_to_call = "archive_course_form";
		174	} else {
		175	$method_to_call = "archive_course_confirm";
		176	}
		177	} elsif (defined $r->param("confirm_archive_course")) {
		178	# validate and archive
		179	@errors = $self->archive_course_validate;
		180	if (@errors) {
		181	$method_to_call = "archive_course_form";
		182	} else {
		183	$method_to_call = "do_archive_course";
		184	}
		185	} else {
		186	# form only
		187	$method_to_call = "archive_course_form";
		188	}
		189	}
		190	elsif ($subDisplay eq "unarchive_course") {
		191	if (defined $r->param("unarchive_course")) {
		192	# validate or confirm
		193	@errors = $self->unarchive_course_validate;
		194	if (@errors) {
		195	$method_to_call = "unarchive_course_form";
		196	} else {
		197	$method_to_call = "unarchive_course_confirm";
		198	}
		199	} elsif (defined $r->param("confirm_unarchive_course")) {
		200	# validate and archive
		201	@errors = $self->unarchive_course_validate;
		202	if (@errors) {
		203	$method_to_call = "unarchive_course_form";
		204	} else {
		205	$method_to_call = "do_unarchive_course";
		206	}
		207	} else {
		208	# form only
		209	$method_to_call = "unarchive_course_form";
		210	}
		211	}
		212	else {
		213	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
		214	}
		215
		216	}
		217
		218	$self->{errors} = \@errors;
		219	$self->{method_to_call} = $method_to_call;
		220	}
		221
		222	sub header {
		223	my ($self) = @_;
		224	my $method_to_call = $self->{method_to_call};
		225	# if (defined $method_to_call and $method_to_call eq "do_export_database") {
		226	# my $r = $self->r;
		227	# my $courseID = $r->param("export_courseID");
		228	# $r->content_type("application/octet-stream");
		229	# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
		230	# $r->send_http_header;
		231	# } else {
		232	$self->SUPER::header;
		233	# }
		234	}
		235
		236	# sends:
		237	#
		238	# HTTP/1.1 200 OK
		239	# Date: Fri, 09 Jul 2004 19:05:55 GMT
		240	# Server: Apache/1.3.27 (Unix) mod_perl/1.27
		241	# Content-Disposition: attachment; filename="mth143_database.xml"
		242	# Connection: close
		243	# Content-Type: application/octet-stream
		244
		245	sub content {
		246	my ($self) = @_;
		247	my $method_to_call = $self->{method_to_call};
		248	if (defined $method_to_call and $method_to_call eq "do_export_database") {
		249	#$self->do_export_database;
		250	$self->SUPER::content;
		251	} else {
		252	$self->SUPER::content;
62	}	253	}
63	}	254	}
64		255
65	sub body {	256	sub body {
66	my ($self) = @_;	257	my ($self) = @_;
…		…
68	my $ce = $r->ce;	259	my $ce = $r->ce;
69	my $db = $r->db;	260	my $db = $r->db;
70	my $authz = $r->authz;	261	my $authz = $r->authz;
71	my $urlpath = $r->urlpath;	262	my $urlpath = $r->urlpath;
72		263
73	my $user = $r->param('user');	264	my $user = $r->param('user');
74		265
75	# check permissions	266	# check permissions
76	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {	267	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
77	return "";	268	return "";
78	}	269	}
		270	my $method_to_call = $self->{method_to_call};
		271	my $methodMessage ="";
		272
		273	(defined($method_to_call) and $method_to_call eq "do_export_database") && do {
		274	my @export_courseID = $r->param("export_courseID");
		275	my $course_ids = join(", ", @export_courseID);
		276	$methodMessage = CGI::p("Exporting database for course(s) $course_ids").
		277	CGI::p(".... please wait....
		278	If your browser times out you will
		279	still be able to download the exported database using the
		280	file manager.").CGI::hr();
		281	};
		282
79		283
80	print CGI::p({style=>"text-align: center"},	284	print CGI::p({style=>"text-align: center"},
81	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),	285	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
		286	add_dbLayout=>'sql_single',
		287	add_templates_course => $ce->{siteDefaults}->{default_templates_course} \|\|""}
		288	)},
		289	"Add Course"
		290	),
82	#" \| ",	291	" \| ",
83	#CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),	292	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
84	" \| ",	293	" \| ",
85	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),	294	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
86	" \| ",	295	" \| ",
87	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),	296	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
88	" \| ",	297	" \| ",
89	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),	298	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
		299	" \| ",
		300	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
		301	"\|",
		302	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"),
		303	CGI::hr(),
		304	$methodMessage,
		305
90	);	306	);
91		307
92	print CGI::hr();	308	my @errors = @{$self->{errors}};
93		309
94	my $subDisplay = $r->param("subDisplay");
95	if (defined $subDisplay) {
96		310
97	if ($subDisplay eq "add_course") {
98	if (defined $r->param("add_course")) {
99	my @errors = $self->add_course_validate;
100	if (@errors) {	311	if (@errors) {
101	print CGI::div({class=>"ResultsWithError"},
102	CGI::p("Please correct the following errors and try again:"),
103	CGI::ul(CGI::li(\@errors)),
104	);
105	$self->add_course_form;
106	} else {
107	$self->do_add_course;
108	}
109	} else {
110	$self->add_course_form;
111	}
112	}
113
114	elsif ($subDisplay eq "delete_course") {
115	if (defined $r->param("delete_course")) {
116	# validate or confirm
117	my @errors = $self->delete_course_validate;
118	if (@errors) {
119	print CGI::div({class=>"ResultsWithError"},
120	CGI::p("Please correct the following errors and try again:"),
121	CGI::ul(CGI::li(\@errors)),
122	);
123	$self->delete_course_form;
124	} else {
125	$self->delete_course_confirm;
126	}
127	} elsif (defined $r->param("confirm_delete_course")) {
128	# validate and delete
129	my @errors = $self->delete_course_validate;
130	if (@errors) {
131	print CGI::div({class=>"ResultsWithError"},
132	CGI::p("Please correct the following errors and try again:"),
133	CGI::ul(CGI::li(\@errors)),
134	);
135	$self->delete_course_form;
136	} else {
137	$self->do_delete_course;
138	}
139	} else {
140	# form only
141	$self->delete_course_form;
142	}
143	}
144
145	elsif ($subDisplay eq "export_database") {
146	if (defined $r->param("export_database")) {
147	my @errors = $self->export_database_validate;
148	if (@errors) {
149	print CGI::div({class=>"ResultsWithError"},
150	CGI::p("Please correct the following errors and try again:"),
151	CGI::ul(CGI::li(\@errors)),
152	);
153	$self->export_database_form;
154	} else {
155	$self->do_export_database;
156	}
157	} else {
158	$self->export_database_form;
159	}
160	}
161
162	elsif ($subDisplay eq "import_database") {
163	if (defined $r->param("import_database")) {
164	my @errors = $self->import_database_validate;
165	if (@errors) {
166	print CGI::div({class=>"ResultsWithError"},
167	CGI::p("Please correct the following errors and try again:"),
168	CGI::ul(CGI::li(\@errors)),
169	);
170	$self->import_database_form;
171	} else {
172	$self->do_import_database;
173	}
174	} else {
175	$self->import_database_form;
176	}
177	}
178
179	else {
180	print CGI::div({class=>"ResultsWithError"},	312	print CGI::div({class=>"ResultsWithError"},
181	"Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.");	313	CGI::p("Please correct the following errors and try again:"),
		314	CGI::ul(CGI::li(\@errors)),
		315	);
182	}	316	}
		317
		318	if (defined $method_to_call and $method_to_call ne "") {
		319	$self->$method_to_call;
		320	} else {
		321
		322	print CGI::h2("Courses");
		323
		324	print CGI::start_ol();
		325
		326	my @courseIDs = listCourses($ce);
		327	foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
		328	next if $courseID eq "admin"; # done already above
		329	my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
		330	my $tempCE = WeBWorK::CourseEnvironment->new(
		331	$ce->{webworkDirs}->{root},
		332	$ce->{webworkURLs}->{root},
		333	$ce->{pg}->{directories}->{root},
		334	$courseID,
		335	);
		336	print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
		337	CGI::code(
		338	$tempCE->{dbLayoutName},
		339	),
		340	(-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"),
183		341
		342	);
		343
184	}	344	}
185		345
		346	print CGI::end_ol();
		347
		348	print CGI::h2("Archived Courses");
		349	print CGI::start_ol();
		350
		351	@courseIDs = listArchivedCourses($ce);
		352	foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
		353	print CGI::li($courseID),
		354	}
		355
		356	print CGI::end_ol();
		357	}
186	return "";	358	return "";
187	}	359	}
188		360
189	################################################################################	361	################################################################################
190		362
…		…
195	#my $db = $r->db;	367	#my $db = $r->db;
196	#my $authz = $r->authz;	368	#my $authz = $r->authz;
197	#my $urlpath = $r->urlpath;	369	#my $urlpath = $r->urlpath;
198		370
199	my $add_courseID = $r->param("add_courseID") \|\| "";	371	my $add_courseID = $r->param("add_courseID") \|\| "";
200	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	372	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
201	my $add_sql_host = $r->param("add_sql_host") \|\| "";	373	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
202	my $add_sql_port = $r->param("add_sql_port") \|\| "";	374
203	my $add_sql_username = $r->param("add_sql_username") \|\| "";	375	my $add_admin_users = $r->param("add_admin_users") \|\| "";
204	my $add_sql_password = $r->param("add_sql_password") \|\| "";	376
205	my $add_sql_database = $r->param("add_sql_database") \|\| "";
206	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
207	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
208	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";	377	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
209	my $add_initial_password = $r->param("add_initial_password") \|\| "";	378	my $add_initial_password = $r->param("add_initial_password") \|\| "";
210	my $add_initial_password_confirm = $r->param("add_initial_password_confirm") \|\| "";	379	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		380	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		381	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
211	my $add_feedback_email = $r->param("add_feedback_email") \|\| "";	382	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		383
212	my $add_templates_course = $r->param("add_templates_course") \|\| "";	384	my $add_templates_course = $r->param("add_templates_course") \|\| "";
213	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";	385
214	my $add_contact_last_name = $r->param("add_contact_last_name") \|\| "";
215	my $add_contact_institution = $r->param("add_contact_institution") \|\| "";
216	my $add_course_title = $r->param("add_course_title") \|\| "";	386	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
217	my $add_contact_email = $r->param("add_contact_email") \|\| "";
218	my $add_admin_userID = $r->param("add_admin_userID") \|\| $r->param("user") \|\| "";
219	my $add_admin_password = $r->param("add_admin_password") \|\| "";
220		387
221	my @dbLayouts = sort keys %{ $ce->{dbLayouts} };	388	my @dbLayouts = do {
		389	my @ordered_layouts;
		390	foreach my $layout (@{$ce->{dbLayout_order}}) {
		391	if (exists $ce->{dbLayouts}->{$layout}) {
		392	push @ordered_layouts, $layout;
		393	}
		394	}
		395
		396	my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
		397	my @other_layouts;
		398	foreach my $layout (keys %{ $ce->{dbLayouts} }) {
		399	unless (exists $ordered_layouts{$layout}) {
		400	push @other_layouts, $layout;
		401	}
		402	}
		403
		404	(@ordered_layouts, @other_layouts);
		405	};
222		406
223	my $ce2 = WeBWorK::CourseEnvironment->new(	407	my $ce2 = WeBWorK::CourseEnvironment->new(
224	$ce->{webworkDirs}->{root},	408	$ce->{webworkDirs}->{root},
225	$ce->{webworkURLs}->{root},	409	$ce->{webworkURLs}->{root},
226	$ce->{pg}->{directories}->{root},	410	$ce->{pg}->{directories}->{root},
227	"COURSENAME",	411	"COURSENAME",
228	);	412	);
229		413
230	my $dbi_source = do {
231	# find the most common SQL source (stolen from CourseManagement.pm)
232	my %sources;
233	foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
234	$sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
235	}
236	my $source;
237	if (keys %sources > 1) {
238	foreach my $curr (keys %sources) {
239	$source = $curr if not defined $source or
240	$sources{$curr} > $sources{$source};
241	}
242	} else {
243	($source) = keys %sources;
244	}
245	$source;
246	};
247
248	my @existingCourses = listCourses($ce);	414	my @existingCourses = listCourses($ce);
		415	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
249		416
250	print CGI::h2("Add Course");	417	print CGI::h2("Add Course");
251		418
252	print CGI::start_form("POST", $r->uri);	419	print CGI::start_form(-method=>"POST", -action=>$r->uri);
253	print $self->hidden_authen_fields;	420	print $self->hidden_authen_fields;
254	print $self->hidden_fields("subDisplay");	421	print $self->hidden_fields("subDisplay");
255		422
256	print CGI::p("Specify a name for the new course.");	423	print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores.");
257		424
258	print CGI::table({class=>"FormLayout"},	425	print CGI::table({class=>"FormLayout"},
259	CGI::Tr(	426	CGI::Tr({},
260	CGI::th({class=>"LeftHeader"}, "Course ID:"),	427	CGI::th({class=>"LeftHeader"}, "Course ID:"),
261	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),	428	CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)),
262	CGI::th({class=>"LeftHeader"}, "Course Title"),
263	CGI::td(CGI::textfield("add_course_title", $add_course_title, 25)),
264	),	429	),
		430	CGI::Tr({},
		431	CGI::th({class=>"LeftHeader"}, "Course Title:"),
		432	CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)),
		433	),
		434	CGI::Tr({},
		435	CGI::th({class=>"LeftHeader"}, "Institution:"),
		436	CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)),
		437	),
265	);	438	);
266		439
267	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.");	440	print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
		441	my @checked = ($add_admin_users) ?(checked=>1): (); # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
		442	print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course"));
268		443
		444	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only
		445	numbers, letters, hyphens, periods (dots), commas,and underscores.\n");
		446
		447	print CGI::table({class=>"FormLayout"}, CGI::Tr({},
		448	CGI::td({},
269	print CGI::table({class=>"FormLayout"},	449	CGI::table({class=>"FormLayout"},
270	CGI::Tr(	450	CGI::Tr({},
271	CGI::th({class=>"CenterHeader"}, "Instructor ID"),	451	CGI::th({class=>"LeftHeader"}, "User ID:"),
		452	CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)),
		453	),
		454	CGI::Tr({},
272	CGI::th({class=>"CenterHeader"}, "Instructor Password"),	455	CGI::th({class=>"LeftHeader"}, "Password:"),
		456	CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)),
		457	),
		458	CGI::Tr({},
273	CGI::th({class=>"CenterHeader"}, "Confirm Instructor Password"),	459	CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
		460	CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)),
		461	),
274		462	),
		463	),
		464	CGI::td({},
		465	CGI::table({class=>"FormLayout"},
		466	CGI::Tr({},
		467	CGI::th({class=>"LeftHeader"}, "First Name:"),
		468	CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)),
		469	),
		470	CGI::Tr({},
		471	CGI::th({class=>"LeftHeader"}, "Last Name:"),
		472	CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)),
		473	),
		474	CGI::Tr({},
		475	CGI::th({class=>"LeftHeader"}, "Email Address:"),
		476	CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)),
		477	),
		478	),
275		479
276	),	480	),
277	CGI::Tr(
278	CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID \|\| "professor", 25)),
279	CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
280	CGI::td(CGI::password_field("add_initial_password_confirm", $add_initial_password_confirm, 25)),
281
282	),
283
284	CGI::Tr(
285	CGI::th({class=>"CenterHeader"}, "First name"),
286	CGI::th({class=>"CenterHeader"}, "Last name"),
287	CGI::th({class=>"CenterHeader"}, " "),
288	),
289	CGI::Tr(
290	CGI::td(CGI::textfield("add_contact_first_name", $add_contact_first_name, 20)),
291	CGI::td(CGI::textfield("add_contact_last_name", $add_contact_last_name, 20)),
292	CGI::th({class=>"CenterHeader"}, " "),
293	),
294	CGI::Tr(
295	CGI::th({class=>"CenterHeader"}, "Contact institution"),
296	CGI::th({class=>"CenterHeader"}, "Contact e-mail"),
297	CGI::th({class=>"CenterHeader"}, " "),
298	),
299	CGI::Tr(
300	CGI::td(CGI::textfield("add_contact_institution", $add_contact_institution, 35)),
301	CGI::td(CGI::textfield("add_contact_email", $add_contact_email, 35)),
302	CGI::th({class=>"CenterHeader"}, " "),
303	),
304	CGI::Tr(
305	CGI::th({class=>"CenterHeader"}, "Administrator ID"),
306	CGI::th({class=>"CenterHeader"}, "Administrator Password"),
307	CGI::th({class=>"CenterHeader"}, "Feedback e-mail"),
308
309	),
310	CGI::Tr(
311	CGI::td(CGI::textfield("add_admin_userID", $add_admin_userID, 25)),
312	CGI::td(CGI::password_field("add_admin_password", $add_admin_password, 25)),
313	CGI::td(CGI::textfield("add_feedback_email", $add_feedback_email, 25)),
314
315	),
316	);	481	));
317		482
318	print CGI::p("Select an existing course from which to copy templates:");	483	print CGI::p("To copy problem templates from an existing course, select the course below.");
319		484
320	print CGI::table({class=>"FormLayout"},	485	print CGI::table({class=>"FormLayout"},
321	CGI::Tr(	486	CGI::Tr({},
322	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),	487	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
323	CGI::td(	488	CGI::td(
324	CGI::popup_menu(	489	CGI::popup_menu(
325	-name => "add_templates_course",	490	-name => "add_templates_course",
326	-values => [ "", @existingCourses ],	491	-values => [ "", @existingCourses ],
…		…
332		497
333	),	498	),
334	),	499	),
335	);	500	);
336		501
337	print CGI::p("Select a database layout below. Some database layouts require additional information.");
338		502
339	#print CGI::start_Tr();
340	#print CGI::th({class=>"LeftHeader"}, "Database Layout:");
341	#print CGI::start_td();
342		503
		504	print CGI::p("Select a database layout below.");
		505	print CGI::start_table({class=>"FormLayout"});
		506
		507	my %dbLayout_buttons;
		508	my $selected_dbLayout = defined $add_dbLayout ? $add_dbLayout : $ce->{dbLayout_order}[0];
		509	@dbLayout_buttons{@dbLayouts} = CGI::radio_group(-name=>"add_dbLayout",-values=>\@dbLayouts,-default=>$selected_dbLayout);
343	foreach my $dbLayout (@dbLayouts) {	510	foreach my $dbLayout (@dbLayouts) {
344	print CGI::start_table({class=>"FormLayout"});	511	my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
345		512	? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
346	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm	513	: "$dbLayout - no description provided in global.conf";
347	print CGI::Tr(	514	print CGI::Tr({},
348	CGI::td({style=>"text-align: right"},	515	CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}),
349	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
350	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
351	),
352	CGI::td($dbLayout),	516	CGI::td($dbLayoutLabel),
353	);
354
355	print CGI::start_Tr();
356	print CGI::td(); # for indentation :(
357	print CGI::start_td();
358
359	if ($dbLayout eq "sql") {
360
361	print CGI::start_table({class=>"FormLayout"});
362	print CGI::Tr(CGI::td({colspan=>2},
363	"The SQL Admin is a user in the SQL database with sufficient permissions to create a new database."
364	)
365	);	517	);
366	print CGI::Tr(
367	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
368	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
369	);
370	print CGI::Tr(
371	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
372	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
373	);
374
375	print CGI::Tr(CGI::td({colspan=>2}, CGI::hr(),
376	"The optionial SQL settings you enter below must match the settings in the DBI source",
377	" specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"),
378	" with the course name you entered above."
379	)
380	);
381	print CGI::Tr(
382	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
383	CGI::td(
384	CGI::textfield("add_sql_host", $add_sql_host, 25),
385	CGI::br(),
386	CGI::small("Leave blank to use the default host."),
387	),
388	);
389	print CGI::Tr(
390	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
391	CGI::td(
392	CGI::textfield("add_sql_port", $add_sql_port, 25),
393	CGI::br(),
394	CGI::small("Leave blank to use the default port."),
395	),
396	);
397
398	print CGI::Tr(
399	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
400	CGI::td(
401	CGI::textfield("add_sql_database", $add_sql_database, 25),
402	CGI::br(),
403	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
404	),
405	);
406	print CGI::Tr(
407	CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
408	CGI::td(
409	CGI::textfield("add_sql_wwhost", $add_sql_wwhost \|\| "localhost", 25),
410	CGI::br(),
411	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."),
412	),
413	);
414	print CGI::end_table();
415	} elsif ($dbLayout eq "gdbm") {
416	print CGI::start_table({class=>"FormLayout"});
417	print CGI::Tr(
418	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
419	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),
420	);
421	print CGI::end_table();
422	}	518	}
423
424	print CGI::end_td();
425	print CGI::end_Tr();
426	print CGI::end_table();	519	print CGI::end_table();
427	}
428
429
430
431
432
433
434
435	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));	520	print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course"));
436		521
437	print CGI::end_form();	522	print CGI::end_form();
438	}	523	}
439		524
440	sub add_course_validate {	525	sub add_course_validate {
…		…
444	#my $db = $r->db;	529	#my $db = $r->db;
445	#my $authz = $r->authz;	530	#my $authz = $r->authz;
446	#my $urlpath = $r->urlpath;	531	#my $urlpath = $r->urlpath;
447		532
448	my $add_courseID = $r->param("add_courseID") \|\| "";	533	my $add_courseID = $r->param("add_courseID") \|\| "";
449	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	534	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
450	my $add_sql_host = $r->param("add_sql_host") \|\| "";	535	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
451	my $add_sql_port = $r->param("add_sql_port") \|\| "";	536
452	my $add_sql_username = $r->param("add_sql_username") \|\| "";	537	my $add_admin_users = $r->param("add_admin_users") \|\| "";
453	my $add_sql_password = $r->param("add_sql_password") \|\| "";	538
454	my $add_sql_database = $r->param("add_sql_database") \|\| "";
455	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
456	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
457	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";	539	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
458	my $add_initial_password = $r->param("add_initial_password") \|\| "";	540	my $add_initial_password = $r->param("add_initial_password") \|\| "";
459	my $add_initial_password_confirm = $r->param("add_initial_password_confirm") \|\| "";	541	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		542	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		543	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
		544	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		545
460	my $add_templates_course = $r->param("add_templates_course") \|\| "";	546	my $add_templates_course = $r->param("add_templates_course") \|\| "";
461	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";	547
462	my $add_contact_last_name = $r->param("add_contact_last_name") \|\| "";
463	my $add_contact_institution = $r->param("add_contact_institution") \|\| "";
464	my $add_contact_email = $r->param("add_contact_email") \|\| "";
465	my $add_course_title = $r->param("add_course_title") \|\| "";	548	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
466	my $add_admin_userID = $r->param("add_admin_userID") \|\| "";	549
467	my $add_admin_password = $r->param("add_admin_password") \|\| "";
468
469	my @errors;	550	my @errors;
470		551
471	if ($add_courseID eq "") {	552	if ($add_courseID eq "") {
472	push @errors, "You must specify a course name.";	553	push @errors, "You must specify a course ID.";
473	}	554	}
474	if ($add_contact_institution eq "") {	555	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
475	push @errors, "You must specify a contact institution." ;	556	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
476	}	557	}
477	if ($add_contact_last_name eq "") {	558	if (grep { $add_courseID eq $_ } listCourses($ce)) {
478	push @errors, "You must specify a contact person.";	559	push @errors, "A course with ID $add_courseID already exists.";
479	}	560	}
480	if ($add_contact_email eq "") {
481	push @errors, "You must specify an email address for the contact person." ;
482	}
483	if ($add_initial_password ne $add_initial_password_confirm) {
484	push @errors, "The instructor's passwords don't match";
485	}
486	if ($add_course_title eq "") {	561	if ($add_courseTitle eq "") {
		562	push @errors, "You must specify a course title.";
		563	}
		564	if ($add_courseInstitution eq "") {
487	push @errors, "You must specify a title for the course.";	565	push @errors, "You must specify an institution for this course.";
		566	}
		567
		568	if ($add_initial_userID ne "") {
		569	if ($add_initial_password eq "") {
		570	push @errors, "You must specify a password for the initial instructor.";
		571	}
		572	if ($add_initial_confirmPassword eq "") {
		573	push @errors, "You must confirm the password for the initial instructor.";
		574	}
		575	if ($add_initial_password ne $add_initial_confirmPassword) {
		576	push @errors, "The password and password confirmation for the instructor must match.";
		577	}
		578	if ($add_initial_firstName eq "") {
		579	push @errors, "You must specify a first name for the initial instructor.";
		580	}
		581	if ($add_initial_lastName eq "") {
		582	push @errors, "You must specify a last name for the initial instructor.";
		583	}
		584	if ($add_initial_email eq "") {
		585	push @errors, "You must specify an email address for the initial instructor.";
		586	}
488	}	587	}
489		588
490	if ($add_dbLayout eq "") {	589	if ($add_dbLayout eq "") {
491	push @errors, "You must select a database layout.";	590	push @errors, "You must select a database layout.";
492	} else {	591	} else {
493	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {	592	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
494	if ($add_dbLayout eq "sql") {	593	# we used to check for layout-specific fields here, but there aren't any layouts that require them
495	push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";	594	# anymore. (in the future, we'll probably deal with this in layout-specific modules.)
496	#push @errors, "You must specify the SQL admin password." if $add_sql_password eq "";
497	#push @errors, "You must specify the SQL database name." if $add_sql_database eq "";
498	push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
499	} elsif ($add_dbLayout eq "gdbm") {
500	push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
501	}
502	} else {	595	} else {
503	push @errors, "The database layout $add_dbLayout doesn't exist.";	596	push @errors, "The database layout $add_dbLayout doesn't exist.";
504	}	597	}
505	}	598	}
506		599
507	if ($add_initial_userID ne "") {
508	push @errors, "You must specify a professor password." if $add_initial_password eq "";
509	}
510	if ($add_admin_userID ne "") {
511	push @errors, "You must specify an admin password for $add_admin_userID." if $add_admin_password eq "";
512	}
513
514
515	return @errors;	600	return @errors;
516	}	601	}
517		602
518	sub do_add_course {	603	sub do_add_course {
519	my ($self) = @_;	604	my ($self) = @_;
520	my $r = $self->r;	605	my $r = $self->r;
521	my $ce = $r->ce;	606	my $ce = $r->ce;
522	my $db = $r->db;	607	my $db = $r->db;
523	#my $authz = $r->authz;	608	my $authz = $r->authz;
524	my $urlpath = $r->urlpath;	609	my $urlpath = $r->urlpath;
525		610
526	my $add_courseID = $r->param("add_courseID") \|\| "";	611	my $add_courseID = $r->param("add_courseID") \|\| "";
527	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	612	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
528	my $add_sql_host = $r->param("add_sql_host") \|\| "";	613	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
529	my $add_sql_port = $r->param("add_sql_port") \|\| "";	614
530	my $add_sql_username = $r->param("add_sql_username") \|\| "";	615	my $add_admin_users = $r->param("add_admin_users") \|\| "";
531	my $add_sql_password = $r->param("add_sql_password") \|\| "";	616
532	my $add_sql_database = $r->param("add_sql_database") \|\| "";
533	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
534	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
535	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";	617	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
536	my $add_initial_password = $r->param("add_initial_password") \|\| "";	618	my $add_initial_password = $r->param("add_initial_password") \|\| "";
		619	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		620	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		621	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
		622	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		623
537	my $add_templates_course = $r->param("add_templates_course") \|\| "";	624	my $add_templates_course = $r->param("add_templates_course") \|\| "";
538	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";	625
539	my $add_contact_last_name = $r->param("add_contact_last_name") \|\| "";	626	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
540	my $add_contact_institution = $r->param("add_contact_institution") \|\| "";
541	my $add_contact_email = $r->param("add_contact_email") \|\| "";
542	my $add_course_title = $r->param("add_course_title") \|\| "";
543	my $add_admin_userID = $r->param("add_admin_userID") \|\| $r->param("user") \|\| "";
544	my $add_admin_password = $r->param("add_admin_password") \|\| "";
545		627
546	my $ce2 = WeBWorK::CourseEnvironment->new(	628	my $ce2 = WeBWorK::CourseEnvironment->new(
547	$ce->{webworkDirs}->{root},	629	$ce->{webworkDirs}->{root},
548	$ce->{webworkURLs}->{root},	630	$ce->{webworkURLs}->{root},
549	$ce->{pg}->{directories}->{root},	631	$ce->{pg}->{directories}->{root},
550	$add_courseID,	632	$add_courseID,
551	);	633	);
552		634
553	my %courseOptions = ( dbLayoutName => $add_dbLayout );	635	my %courseOptions = ( dbLayoutName => $add_dbLayout );
554	if ($add_dbLayout eq "gdbm") {
555	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
556	}
557		636
		637	if ($add_initial_email ne "") {
		638	$courseOptions{allowedRecipients} = [ $add_initial_email ];
		639	# don't set feedbackRecipients -- this just gets in the way of the more
		640	# intelligent "receive_recipients" method.
		641	#$courseOptions{feedbackRecipients} = [ $add_initial_email ];
		642	}
		643
		644	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
		645	# below this line, we would grab values from getopt and put them in this hash
		646	# but for now the hash can remain empty
558	my %dbOptions;	647	my %dbOptions;
559	if ($add_dbLayout eq "sql") {	648
560	$dbOptions{host} = $add_sql_host if $add_sql_host ne "";
561	$dbOptions{port} = $add_sql_port if $add_sql_port ne "";
562	$dbOptions{username} = $add_sql_username;
563	$dbOptions{password} = $add_sql_password;
564	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";
565	$dbOptions{wwhost} = $add_sql_wwhost;
566	}
567	# add professor and administor if defined.
568	my @users;	649	my @users;
		650
		651	# copy users from current (admin) course if desired
		652	if ($add_admin_users ne "") {
		653	foreach my $userID ($db->listUsers) {
		654	if ($userID eq $add_initial_userID) {
		655	$self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
		656	next;
		657	}
		658	my $User = $db->getUser($userID);
		659	my $Password = $db->getPassword($userID);
		660	my $PermissionLevel = $db->getPermissionLevel($userID);
		661	push @users, [ $User, $Password, $PermissionLevel ]
		662	if $authz->hasPermissions($userID,"create_and_delete_courses");
		663	#only transfer the "instructors" in the admin course classlist.
		664	}
		665	}
		666
		667	# add initial instructor if desired
569	if ($add_initial_userID ne "") {	668	if ($add_initial_userID ne "") {
570	my $User = $db->newUser(	669	my $User = $db->newUser(
571	user_id => $add_initial_userID,	670	user_id => $add_initial_userID,
		671	first_name => $add_initial_firstName,
		672	last_name => $add_initial_lastName,
		673	student_id => $add_initial_userID,
		674	email_address => $add_initial_email,
572	status => "C",	675	status => "C",
573	);	676	);
574	my $Password = $db->newPassword(	677	my $Password = $db->newPassword(
575	user_id => $add_initial_userID,	678	user_id => $add_initial_userID,
576	password => cryptPassword($add_initial_password),	679	password => cryptPassword($add_initial_password),
577	);	680	);
578	my $PermissionLevel = $db->newPermissionLevel(	681	my $PermissionLevel = $db->newPermissionLevel(
579	user_id => $add_initial_userID,	682	user_id => $add_initial_userID,
580	permission => "10",	683	permission => "10",
581	);	684	);
582	push @users, [ $User, $Password, $PermissionLevel ];	685	push @users, [ $User, $Password, $PermissionLevel ];
583	}	686	}
584	if ($add_admin_userID ne "") {	687
585	my $User = $db->newUser(	688	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
586	user_id => $add_admin_userID,	689
587	status => "C",
588	);
589	my $Password = $db->newPassword(
590	user_id => $add_admin_userID,
591	password => cryptPassword($add_admin_password),
592	);
593	my $PermissionLevel = $db->newPermissionLevel(
594	user_id => $add_admin_userID,
595	permission => "10",
596	);
597	push @users, [ $User, $Password, $PermissionLevel ];
598	}
599	my %optional_arguments;	690	my %optional_arguments;
600	if ($add_templates_course ne "") {	691	if ($add_templates_course ne "") {
601	$optional_arguments{templatesFrom} = $add_templates_course;	692	$optional_arguments{templatesFrom} = $add_templates_course;
602	}	693	}
603		694
…		…
609	dbOptions => \%dbOptions,	700	dbOptions => \%dbOptions,
610	users => \@users,	701	users => \@users,
611	%optional_arguments,	702	%optional_arguments,
612	);	703	);
613	};	704	};
614
615	if ($@) {	705	if ($@) {
616	my $error = $@;	706	my $error = $@;
617	print CGI::div({class=>"ResultsWithError"},	707	print CGI::div({class=>"ResultsWithError"},
618	CGI::p("An error occured while creating the course $add_courseID:"),	708	CGI::p("An error occured while creating the course $add_courseID:"),
619	CGI::tt(CGI::escapeHTML($error)),	709	CGI::tt(CGI::escapeHTML($error)),
…		…
631	}	721	}
632	} else {	722	} else {
633	#log the action	723	#log the action
634	writeLog($ce, "hosted_courses", join("\t",	724	writeLog($ce, "hosted_courses", join("\t",
635	"\tAdded",	725	"\tAdded",
636	$add_contact_institution,	726	$add_courseInstitution,
637	$add_course_title,	727	$add_courseTitle,
638	$add_courseID,	728	$add_courseID,
639	$add_contact_first_name,	729	$add_initial_firstName,
640	$add_contact_last_name,	730	$add_initial_lastName,
641	$add_contact_email,	731	$add_initial_email,
642	));	732	));
643	# add contact to admin course as student?	733	# add contact to admin course as student?
644	# FIXME -- should we do this?	734	# FIXME -- should we do this?
		735	if ($add_initial_userID ne "") {
		736	my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact
		737	my $User = $db->newUser(
		738	user_id => $composite_id, # student id includes school name and contact
		739	first_name => $add_initial_firstName,
		740	last_name => $add_initial_lastName,
		741	student_id => $add_initial_userID,
		742	email_address => $add_initial_email,
		743	status => "C",
		744	);
		745	my $Password = $db->newPassword(
		746	user_id => $composite_id,
		747	password => cryptPassword($add_initial_password),
		748	);
		749	my $PermissionLevel = $db->newPermissionLevel(
		750	user_id => $composite_id,
		751	permission => "0",
		752	);
		753	# add contact to admin course as student
		754	# or if this contact and course already exist in a dropped status
		755	# change the student's status to enrolled
		756	if (my $oldUser = $db->getUser($composite_id) ) {
		757	warn "Replacing old data for $composite_id status: ". $oldUser->status;
		758	$db->deleteUser($composite_id);
		759	}
		760	eval { $db->addUser($User) }; warn $@ if $@;
		761	eval { $db->addPassword($Password) }; warn $@ if $@;
		762	eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@;
		763	}
645	print CGI::div({class=>"ResultsWithoutError"},	764	print CGI::div({class=>"ResultsWithoutError"},
646	CGI::p("Successfully created the course $add_courseID"),	765	CGI::p("Successfully created the course $add_courseID"),
647	);	766	);
648	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",	767	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
649	courseID => $add_courseID);	768	courseID => $add_courseID);
650	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);	769	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
651	print CGI::div({style=>"text-align: center"},	770	print CGI::div({style=>"text-align: center"},
652	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),	771	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
653	);	772	);
654	}	773	}
		774
655		775
656	}	776	}
657		777
658	################################################################################	778	################################################################################
659		779
660	sub delete_course_form {	780	sub rename_course_form {
661	my ($self) = @_;	781	my ($self) = @_;
662	my $r = $self->r;	782	my $r = $self->r;
663	my $ce = $r->ce;	783	my $ce = $r->ce;
664	#my $db = $r->db;	784	#my $db = $r->db;
665	#my $authz = $r->authz;	785	#my $authz = $r->authz;
666	#my $urlpath = $r->urlpath;	786	#my $urlpath = $r->urlpath;
667		787
668	my $delete_courseID = $r->param("delete_courseID") \|\| "";	788	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
669	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";	789	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
670	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
671	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
672	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
673	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
674		790
675	my @courseIDs = listCourses($ce);	791	my @courseIDs = listCourses($ce);
676	@courseIDs = sort @courseIDs;	792	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
677		793
678	my %courseLabels; # records... heh.	794	my %courseLabels; # records... heh.
679	foreach my $courseID (@courseIDs) {	795	foreach my $courseID (@courseIDs) {
680	my $tempCE = WeBWorK::CourseEnvironment->new(	796	my $tempCE = WeBWorK::CourseEnvironment->new(
681	$ce->{webworkDirs}->{root},	797	$ce->{webworkDirs}->{root},
…		…
684	$courseID,	800	$courseID,
685	);	801	);
686	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	802	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
687	}	803	}
688		804
689	print CGI::h2("Delete Course");	805	print CGI::h2("Rename Course");
690		806
691	print CGI::start_form("POST", $r->uri);	807	print CGI::start_form(-method=>"POST", -action=>$r->uri);
692	print $self->hidden_authen_fields;	808	print $self->hidden_authen_fields;
693	print $self->hidden_fields("subDisplay");	809	print $self->hidden_fields("subDisplay");
694		810
		811	print CGI::p("Select a course to rename.");
		812
		813	print CGI::table({class=>"FormLayout"},
		814	CGI::Tr({},
		815	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		816	CGI::td(
		817	CGI::scrolling_list(
		818	-name => "rename_oldCourseID",
		819	-values => \@courseIDs,
		820	-default => $rename_oldCourseID,
		821	-size => 10,
		822	-multiple => 0,
		823	-labels => \%courseLabels,
		824	),
		825	),
		826	),
		827	CGI::Tr({},
		828	CGI::th({class=>"LeftHeader"}, "New Name:"),
		829	CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)),
		830	),
		831	);
		832
		833	print CGI::end_table();
		834
		835	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course"));
		836
		837	print CGI::end_form();
		838	}
		839
		840	sub rename_course_validate {
		841	my ($self) = @_;
		842	my $r = $self->r;
		843	my $ce = $r->ce;
		844	#my $db = $r->db;
		845	#my $authz = $r->authz;
		846	#my $urlpath = $r->urlpath;
		847
		848	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		849	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		850
		851	my @errors;
		852
		853	if ($rename_oldCourseID eq "") {
		854	push @errors, "You must select a course to rename.";
		855	}
		856	if ($rename_newCourseID eq "") {
		857	push @errors, "You must specify a new name for the course.";
		858	}
		859	if ($rename_oldCourseID eq $rename_newCourseID) {
		860	push @errors, "Can't rename to the same name.";
		861	}
		862	unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
		863	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
		864	}
		865	if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
		866	push @errors, "A course with ID $rename_newCourseID already exists.";
		867	}
		868
		869	my $ce2 = WeBWorK::CourseEnvironment->new(
		870	$ce->{webworkDirs}->{root},
		871	$ce->{webworkURLs}->{root},
		872	$ce->{pg}->{directories}->{root},
		873	$rename_oldCourseID,
		874	);
		875
		876	return @errors;
		877	}
		878
		879	sub do_rename_course {
		880	my ($self) = @_;
		881	my $r = $self->r;
		882	my $ce = $r->ce;
		883	my $db = $r->db;
		884	#my $authz = $r->authz;
		885	my $urlpath = $r->urlpath;
		886
		887	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		888	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		889
		890	my $ce2 = WeBWorK::CourseEnvironment->new(
		891	$ce->{webworkDirs}->{root},
		892	$ce->{webworkURLs}->{root},
		893	$ce->{pg}->{directories}->{root},
		894	$rename_oldCourseID,
		895	);
		896
		897	my $dbLayoutName = $ce->{dbLayoutName};
		898
		899	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
		900	# below this line, we would grab values from getopt and put them in this hash
		901	# but for now the hash can remain empty
		902	my %dbOptions;
		903
		904	eval {
		905	renameCourse(
		906	courseID => $rename_oldCourseID,
		907	ce => $ce2,
		908	dbOptions => \%dbOptions,
		909	newCourseID => $rename_newCourseID,
		910	);
		911	};
		912	if ($@) {
		913	my $error = $@;
		914	print CGI::div({class=>"ResultsWithError"},
		915	CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
		916	CGI::tt(CGI::escapeHTML($error)),
		917	);
		918	} else {
		919	print CGI::div({class=>"ResultsWithoutError"},
		920	CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
		921	);
		922	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
		923	courseID => $rename_newCourseID);
		924	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
		925	print CGI::div({style=>"text-align: center"},
		926	CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
		927	);
		928	}
		929	}
		930
		931	################################################################################
		932
		933	sub delete_course_form {
		934	my ($self) = @_;
		935	my $r = $self->r;
		936	my $ce = $r->ce;
		937	#my $db = $r->db;
		938	#my $authz = $r->authz;
		939	#my $urlpath = $r->urlpath;
		940
		941	my $delete_courseID = $r->param("delete_courseID") \|\| "";
		942
		943	my @courseIDs = listCourses($ce);
		944	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		945
		946	my %courseLabels; # records... heh.
		947	foreach my $courseID (@courseIDs) {
		948	my $tempCE = WeBWorK::CourseEnvironment->new(
		949	$ce->{webworkDirs}->{root},
		950	$ce->{webworkURLs}->{root},
		951	$ce->{pg}->{directories}->{root},
		952	$courseID,
		953	);
		954	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		955	}
		956
		957	print CGI::h2("Delete Course");
		958
		959	print CGI::start_form(-method=>"POST", -action=>$r->uri);
		960	print $self->hidden_authen_fields;
		961	print $self->hidden_fields("subDisplay");
		962
695	print CGI::p("Select a course to delete.");	963	print CGI::p("Select a course to delete.");
696		964
697	print CGI::table({class=>"FormLayout"},	965	print CGI::table({class=>"FormLayout"},
698	CGI::Tr(	966	CGI::Tr({},
699	CGI::th({class=>"LeftHeader"}, "Course Name:"),	967	CGI::th({class=>"LeftHeader"}, "Course Name:"),
700	CGI::td(	968	CGI::td(
701	CGI::scrolling_list(	969	CGI::scrolling_list(
702	-name => "delete_courseID",	970	-name => "delete_courseID",
703	-values => \@courseIDs,	971	-values => \@courseIDs,
…		…
708	),	976	),
709	),	977	),
710	),	978	),
711	);	979	);
712		980
713	print CGI::p(
714	"If the course's database layout (indicated in parentheses above) is "
715	. CGI::b("sql") . ", supply the SQL connections information requested below."
716	);
717
718	print CGI::start_table({class=>"FormLayout"});
719	print CGI::Tr(
720	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
721	CGI::td(
722	CGI::textfield("delete_sql_host", $delete_sql_host, 25),
723	CGI::br(),
724	CGI::small("Leave blank to use the default host."),
725	),
726	);
727	print CGI::Tr(
728	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
729	CGI::td(
730	CGI::textfield("delete_sql_port", $delete_sql_port, 25),
731	CGI::br(),
732	CGI::small("Leave blank to use the default port."),
733	),
734	);
735	print CGI::Tr(
736	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
737	CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
738	);
739	print CGI::Tr(
740	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
741	CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
742	);
743	print CGI::Tr(
744	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
745	CGI::td(
746	CGI::textfield("delete_sql_database", $delete_sql_database, 25),
747	CGI::br(),
748	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
749	),
750	);
751	print CGI::end_table();
752
753	print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));	981	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course", -value=>"Delete Course"));
754		982
755	print CGI::end_form();	983	print CGI::end_form();
756	}	984	}
757		985
758	sub delete_course_validate {	986	sub delete_course_validate {
…		…
762	#my $db = $r->db;	990	#my $db = $r->db;
763	#my $authz = $r->authz;	991	#my $authz = $r->authz;
764	my $urlpath = $r->urlpath;	992	my $urlpath = $r->urlpath;
765		993
766	my $delete_courseID = $r->param("delete_courseID") \|\| "";	994	my $delete_courseID = $r->param("delete_courseID") \|\| "";
767	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
768	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
769	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
770	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
771	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
772		995
773	my @errors;	996	my @errors;
774		997
775	if ($delete_courseID eq "") {	998	if ($delete_courseID eq "") {
776	push @errors, "You must specify a course name.";	999	push @errors, "You must specify a course name.";
…		…
783	$ce->{webworkURLs}->{root},	1006	$ce->{webworkURLs}->{root},
784	$ce->{pg}->{directories}->{root},	1007	$ce->{pg}->{directories}->{root},
785	$delete_courseID,	1008	$delete_courseID,
786	);	1009	);
787		1010
788	if ($ce2->{dbLayoutName} eq "sql") {
789	push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
790	#push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
791	#push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
792	}
793
794	return @errors;	1011	return @errors;
795	}	1012	}
796		1013
797	sub delete_course_confirm {	1014	sub delete_course_confirm {
798	my ($self) = @_;	1015	my ($self) = @_;
…		…
803	#my $urlpath = $r->urlpath;	1020	#my $urlpath = $r->urlpath;
804		1021
805	print CGI::h2("Delete Course");	1022	print CGI::h2("Delete Course");
806		1023
807	my $delete_courseID = $r->param("delete_courseID") \|\| "";	1024	my $delete_courseID = $r->param("delete_courseID") \|\| "";
808	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
809	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
810	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
811		1025
812	my $ce2 = WeBWorK::CourseEnvironment->new(	1026	my $ce2 = WeBWorK::CourseEnvironment->new(
813	$ce->{webworkDirs}->{root},	1027	$ce->{webworkDirs}->{root},
814	$ce->{webworkURLs}->{root},	1028	$ce->{webworkURLs}->{root},
815	$ce->{pg}->{directories}->{root},	1029	$ce->{pg}->{directories}->{root},
816	$delete_courseID,	1030	$delete_courseID,
817	);	1031	);
818		1032
819	if ($ce2->{dbLayoutName} eq "sql") {
820	print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)	1033	print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
821	. "? All course files and data and the following database will be destroyed."
822	. " There is no undo available.");
823
824	print CGI::table({class=>"FormLayout"},
825	CGI::Tr(
826	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
827	CGI::td($delete_sql_host \|\| "system default"),
828	),
829	CGI::Tr(
830	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
831	CGI::td($delete_sql_port \|\| "system default"),
832	),
833	CGI::Tr(
834	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
835	CGI::td($delete_sql_database \|\| "webwork_$delete_courseID"),
836	),
837	);
838	} else {
839	print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
840	. "? All course files and data will be destroyed. There is no undo available.");	1034	. "? All course files and data will be destroyed. There is no undo available.");
841	}
842		1035
843	print CGI::start_form("POST", $r->uri);	1036	print CGI::start_form(-method=>"POST", -action=>$r->uri);
844	print $self->hidden_authen_fields;	1037	print $self->hidden_authen_fields;
845	print $self->hidden_fields("subDisplay");	1038	print $self->hidden_fields("subDisplay");
846	print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);	1039	print $self->hidden_fields(qw/delete_courseID/);
847		1040
848	print CGI::p({style=>"text-align: center"},	1041	print CGI::p({style=>"text-align: center"},
849	CGI::submit("decline_delete_course", "Don't delete"),	1042	CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"),
850	" ",	1043	" ",
851	CGI::submit("confirm_delete_course", "Delete"),	1044	CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"),
852	);	1045	);
853		1046
854	print CGI::end_form();	1047	print CGI::end_form();
855	}	1048	}
856		1049
857	sub do_delete_course {	1050	sub do_delete_course {
858	my ($self) = @_;	1051	my ($self) = @_;
859	my $r = $self->r;	1052	my $r = $self->r;
860	my $ce = $r->ce;	1053	my $ce = $r->ce;
861	#my $db = $r->db;	1054	my $db = $r->db;
862	#my $authz = $r->authz;	1055	#my $authz = $r->authz;
863	#my $urlpath = $r->urlpath;	1056	#my $urlpath = $r->urlpath;
864		1057
865	my $delete_courseID = $r->param("delete_courseID") \|\| "";	1058	my $delete_courseID = $r->param("delete_courseID") \|\| "";
866	my $delete_sql_host = $r->param("delete_sql_host") \|\| "";
867	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
868	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
869	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
870	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
871		1059
872	my $ce2 = WeBWorK::CourseEnvironment->new(	1060	my $ce2 = WeBWorK::CourseEnvironment->new(
873	$ce->{webworkDirs}->{root},	1061	$ce->{webworkDirs}->{root},
874	$ce->{webworkURLs}->{root},	1062	$ce->{webworkURLs}->{root},
875	$ce->{pg}->{directories}->{root},	1063	$ce->{pg}->{directories}->{root},
876	$delete_courseID,	1064	$delete_courseID,
877	);	1065	);
878		1066
		1067	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
		1068	# below this line, we would grab values from getopt and put them in this hash
		1069	# but for now the hash can remain empty
879	my %dbOptions;	1070	my %dbOptions;
880	if ($ce2->{dbLayoutName} eq "sql") {
881	$dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
882	$dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
883	$dbOptions{username} = $delete_sql_username;
884	$dbOptions{password} = $delete_sql_password;
885	$dbOptions{database} = $delete_sql_database \|\| "webwork_$delete_courseID";
886	}
887		1071
888	eval {	1072	eval {
889	deleteCourse(	1073	deleteCourse(
890	courseID => $delete_courseID,	1074	courseID => $delete_courseID,
891	ce => $ce2,	1075	ce => $ce2,
…		…
898	print CGI::div({class=>"ResultsWithError"},	1082	print CGI::div({class=>"ResultsWithError"},
899	CGI::p("An error occured while deleting the course $delete_courseID:"),	1083	CGI::p("An error occured while deleting the course $delete_courseID:"),
900	CGI::tt(CGI::escapeHTML($error)),	1084	CGI::tt(CGI::escapeHTML($error)),
901	);	1085	);
902	} else {	1086	} else {
		1087	# mark the contact person in the admin course as dropped.
		1088	# find the contact person for the course by searching the admin classlist.
		1089	my @contacts = grep /_$delete_courseID$/, $db->listUsers;
		1090	if (@contacts) {
		1091	die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1;
		1092	#warn "contacts", join(" ", @contacts);
		1093	#my $composite_id = "${add_initial_userID}_${add_courseID}";
		1094	my $composite_id = $contacts[0];
		1095
		1096	# mark the contact person as dropped.
		1097	my $User = $db->getUser($composite_id);
		1098	my $status_name = 'Drop';
		1099	my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
		1100	$User->status($status_value);
		1101	$db->putUser($User);
		1102	}
		1103
903	print CGI::div({class=>"ResultsWithoutError"},	1104	print CGI::div({class=>"ResultsWithoutError"},
904	CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),	1105	CGI::p("Successfully deleted the course $delete_courseID."),
905	);	1106	);
906	writeLog($ce, "hosted_courses", join("\t",	1107	writeLog($ce, "hosted_courses", join("\t",
907	"\tDeleted",	1108	"\tDeleted",
908	"",	1109	"",
909	"",	1110	"",
910	$delete_courseID,	1111	$delete_courseID,
911	));	1112	));
912	print CGI::start_form("POST", $r->uri);	1113	print CGI::start_form(-method=>"POST", -action=>$r->uri);
913	print $self->hidden_authen_fields;	1114	print $self->hidden_authen_fields;
914	print $self->hidden_fields("subDisplay");	1115	print $self->hidden_fields("subDisplay");
915		1116
916	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);	1117	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),);
917		1118
918	print CGI::end_form();	1119	print CGI::end_form();
919	}	1120	}
920	}	1121	}
921		1122
…		…
931		1132
932	my @tables = keys %{$ce->{dbLayout}};	1133	my @tables = keys %{$ce->{dbLayout}};
933		1134
934	my $export_courseID = $r->param("export_courseID") \|\| "";	1135	my $export_courseID = $r->param("export_courseID") \|\| "";
935	my @export_tables = $r->param("export_tables");	1136	my @export_tables = $r->param("export_tables");
936		1137
937	@export_tables = @tables unless @export_tables;	1138	@export_tables = @tables unless @export_tables;
938		1139
939	my @courseIDs = listCourses($ce);	1140	my @courseIDs = listCourses($ce);
940	@courseIDs = sort @courseIDs;	1141	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
941		1142
942	my %courseLabels; # records... heh.	1143	my %courseLabels; # records... heh.
943	foreach my $courseID (@courseIDs) {	1144	foreach my $courseID (@courseIDs) {
944	my $tempCE = WeBWorK::CourseEnvironment->new(	1145	my $tempCE = WeBWorK::CourseEnvironment->new(
945	$ce->{webworkDirs}->{root},	1146	$ce->{webworkDirs}->{root},
…		…
950	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1151	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
951	}	1152	}
952		1153
953	print CGI::h2("Export Database");	1154	print CGI::h2("Export Database");
954		1155
		1156	print CGI::p(IMPORT_EXPORT_WARNING);
		1157
955	print CGI::start_form("POST", $r->uri);	1158	print CGI::start_form(-method=>"GET", -action=>$r->uri);
956	print $self->hidden_authen_fields;	1159	print $self->hidden_authen_fields;
957	print $self->hidden_fields("subDisplay");	1160	print $self->hidden_fields("subDisplay");
958		1161
959	print CGI::p("Select a course to export the course's database.");	1162	print CGI::p({},"Select a course to export the course's database. Please note
		1163	that exporting can take a very long time for a large course. If you have
		1164	shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
		1165	utility instead.");
960		1166
961	print CGI::table({class=>"FormLayout"},	1167	print CGI::table({class=>"FormLayout"},
962	CGI::Tr(	1168	CGI::Tr({},
963	CGI::th({class=>"LeftHeader"}, "Course Name:"),	1169	CGI::th({class=>"LeftHeader"}, "Course Name:"),
964	CGI::td(	1170	CGI::td(
965	CGI::scrolling_list(	1171	CGI::scrolling_list(
966	-name => "export_courseID",	1172	-name => "export_courseID",
967	-values => \@courseIDs,	1173	-values => \@courseIDs,
968	-default => $export_courseID,	1174	-default => $export_courseID,
969	-size => 10,	1175	-size => 10,
970	-multiple => 0,	1176	-multiple => 1,
971	-labels => \%courseLabels,	1177	-labels => \%courseLabels,
972	),	1178	),
973	),	1179	),
974	),	1180	),
975	CGI::Tr(	1181	CGI::Tr({},
976	CGI::th({class=>"LeftHeader"}, "Tables to Export:"),	1182	CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
977	CGI::td(	1183	CGI::td({},
978	CGI::checkbox_group(	1184	CGI::checkbox_group(
979	-name => "export_tables",	1185	-name => "export_tables",
980	-values => \@tables,	1186	-values => \@tables,
981	-default => \@export_tables,	1187	-default => \@export_tables,
982	-linebreak => 1,	1188	-linebreak => 1,
983	),	1189	),
984	),	1190	),
985	),	1191	),
986	);	1192	);
987		1193
988	print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));	1194	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"export_database", -value=>"Export Database"));
989		1195
990	print CGI::end_form();	1196	print CGI::end_form();
991	}	1197	}
992		1198
993	sub export_database_validate {	1199	sub export_database_validate {
…		…
996	#my $ce = $r->ce;	1202	#my $ce = $r->ce;
997	#my $db = $r->db;	1203	#my $db = $r->db;
998	#my $authz = $r->authz;	1204	#my $authz = $r->authz;
999	#my $urlpath = $r->urlpath;	1205	#my $urlpath = $r->urlpath;
1000		1206
1001	my $export_courseID = $r->param("export_courseID") \|\| "";	1207	my @export_courseID = $r->param("export_courseID") \|\| ();
1002	my @export_tables = $r->param("export_tables");	1208	my @export_tables = $r->param("export_tables");
1003		1209
1004	my @errors;	1210	my @errors;
1005		1211
1006	if ($export_courseID eq "") {	1212	unless ( @export_courseID) {
1007	push @errors, "You must specify a course name.";	1213	push @errors, "You must specify at least one course name.";
1008	}	1214	}
1009		1215
1010	unless (@export_tables) {	1216	unless (@export_tables) {
1011	push @errors, "You must specify at least one table to export.";	1217	push @errors, "You must specify at least one table to export.";
1012	}	1218	}
…		…
1020	my $ce = $r->ce;	1226	my $ce = $r->ce;
1021	#my $db = $r->db;	1227	#my $db = $r->db;
1022	#my $authz = $r->authz;	1228	#my $authz = $r->authz;
1023	my $urlpath = $r->urlpath;	1229	my $urlpath = $r->urlpath;
1024		1230
1025	my $export_courseID = $r->param("export_courseID");	1231	my @export_courseID = $r->param("export_courseID");
1026	my @export_tables = $r->param("export_tables");	1232	my @export_tables = $r->param("export_tables");
1027		1233
		1234	foreach my $export_courseID (@export_courseID) {
		1235
1028	my $ce2 = WeBWorK::CourseEnvironment->new(	1236	my $ce2 = WeBWorK::CourseEnvironment->new(
1029	$ce->{webworkDirs}->{root},	1237	$ce->{webworkDirs}->{root},
1030	$ce->{webworkURLs}->{root},	1238	$ce->{webworkURLs}->{root},
1031	$ce->{pg}->{directories}->{root},	1239	$ce->{pg}->{directories}->{root},
1032	$export_courseID,	1240	$export_courseID,
1033	);	1241	);
1034		1242
1035	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1243	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1036		1244
1037	my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});	1245	#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1038	my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;	1246	#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
		1247	# export to the admin/templates directory
		1248	my $exportFileName = "$export_courseID.exported.xml";
		1249	my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
		1250	# get a unique name
		1251	my $number =1;
		1252	while (-e "$exportFilePath.$number.gz") {
		1253	$number++;
		1254	last if $number>9;
		1255	}
		1256	if ($number<=9 ) {
		1257	$exportFilePath = "$exportFilePath.$number";
		1258	$exportFileName = "$exportFileName.$number";
		1259	} else {
		1260	$self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
		1261	remove some of these files."));
		1262	$exportFilePath = "$exportFilePath.999";
		1263	$exportFileName = "$exportFileName.999";
		1264	}
1039		1265
		1266	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
		1267
1040	my @errors;	1268	my @errors;
1041
1042	eval {	1269	eval {
1043	@errors = dbExport(	1270	@errors = dbExport(
1044	db => $db2,	1271	db => $db2,
1045	xml => $fh,	1272	#xml => $fh,
		1273	xml => $outputFileHandle,
1046	tables => \@export_tables,	1274	tables => \@export_tables,
1047	);	1275	);
1048	};	1276	};
		1277
		1278	$outputFileHandle->close();
1049		1279
		1280	my $gzipMessage = system( 'gzip', $exportFilePath);
		1281	if ( !$gzipMessage ) {
		1282	$self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
		1283	You may download it with the file manager."));
		1284	} else {
		1285	$self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
		1286	}
		1287	unlink $exportFilePath;
		1288	} # end export of one course
1050	push @errors, "Fatal exception: $@" if $@;	1289	#push @errors, "Fatal exception: $@" if $@;
1051		1290	#
1052	if (@errors) {	1291	#if (@errors) {
1053	print CGI::div({class=>"ResultsWithError"},	1292	# print CGI::div({class=>"ResultsWithError"},
1054	CGI::p("An error occured while exporting the database of course $export_courseID:"),	1293	# CGI::p("An error occured while exporting the database of course $export_courseID:"),
1055	CGI::ul(CGI::li(\@errors)),	1294	# CGI::ul(CGI::li(\@errors)),
1056	);	1295	# );
1057	} else {	1296	#} else {
1058	print CGI::div({class=>"ResultsWithoutError"},	1297	# print CGI::div({class=>"ResultsWithoutError"},
1059	CGI::p("Export succeeded."),	1298	# CGI::p("Export succeeded."),
1060	);	1299	# );
1061		1300	#
1062	print CGI::div({style=>"text-align: center"},	1301	# print CGI::div({style=>"text-align: center"},
1063	CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),	1302	# CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1064	);	1303	# );
1065	}	1304	#}
1066	}	1305	}
1067		1306
1068	################################################################################	1307	################################################################################
1069		1308
1070	sub import_database_form {	1309	sub import_database_form {
…		…
1083	my $import_conflict = $r->param("import_conflict") \|\| "skip";	1322	my $import_conflict = $r->param("import_conflict") \|\| "skip";
1084		1323
1085	@import_tables = @tables unless @import_tables;	1324	@import_tables = @tables unless @import_tables;
1086		1325
1087	my @courseIDs = listCourses($ce);	1326	my @courseIDs = listCourses($ce);
1088	@courseIDs = sort @courseIDs;	1327	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1089		1328
1090		1329
1091	my %courseLabels; # records... heh.	1330	my %courseLabels; # records... heh.
1092	foreach my $courseID (@courseIDs) {	1331	foreach my $courseID (@courseIDs) {
1093	my $tempCE = WeBWorK::CourseEnvironment->new(	1332	my $tempCE = WeBWorK::CourseEnvironment->new(
…		…
1097	$courseID,	1336	$courseID,
1098	);	1337	);
1099	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1338	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1100	}	1339	}
1101		1340
		1341	# find databases:
		1342	my $templatesDir = $ce->{courseDirs}->{templates};
		1343	my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
		1344	my $exempt_dirs = join("\|", keys %probLibs);
		1345
		1346	my @databaseFiles = listFilesRecursive(
		1347	$templatesDir,
		1348	qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
		1349	qr/^(?:$exempt_dirs\|CVS)$/, # prune these directories
		1350	0, # match against file name only
		1351	1, # prune against path relative to $templatesDir
		1352	);
		1353
		1354	my %databaseLabels = map { ($_ => $_) } @databaseFiles;
		1355
		1356	#######
		1357
1102	print CGI::h2("Import Database");	1358	print CGI::h2("Import Database");
1103		1359
		1360	print CGI::p(IMPORT_EXPORT_WARNING);
		1361
1104	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);	1362	print CGI::start_form(-method=>"POST", -action=>$r->uri, -enctype=>&CGI::MULTIPART);
1105	print $self->hidden_authen_fields;	1363	print $self->hidden_authen_fields;
1106	print $self->hidden_fields("subDisplay");	1364	print $self->hidden_fields("subDisplay");
1107		1365
1108	print CGI::table({class=>"FormLayout"},	1366	print CGI::table({class=>"FormLayout"},
1109	CGI::Tr(	1367	CGI::Tr({},
1110	CGI::th({class=>"LeftHeader"}, "Database XML File:"),	1368	CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1111	CGI::td(	1369	CGI::td(
1112	CGI::filefield(	1370	CGI::scrolling_list(
1113	-name => "import_file",	1371	-name => "import_file",
		1372	-values => \@databaseFiles,
		1373	-default => undef,
1114	-size => 50,	1374	-size => 10,
		1375	-multiple => 0,
		1376	-labels => \%databaseLabels,
1115	),	1377	),
		1378
1116	),	1379	)
1117	),	1380	),
1118	CGI::Tr(	1381	CGI::Tr({},
1119	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),	1382	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1120	CGI::td(	1383	CGI::td(
1121	CGI::checkbox_group(	1384	CGI::checkbox_group(
1122	-name => "import_tables",	1385	-name => "import_tables",
1123	-values => \@tables,	1386	-values => \@tables,
1124	-default => \@import_tables,	1387	-default => \@import_tables,
1125	-linebreak => 1,	1388	-linebreak => 1,
1126	),	1389	),
1127	),	1390	),
1128	),	1391	),
1129	CGI::Tr(	1392	CGI::Tr({},
1130	CGI::th({class=>"LeftHeader"}, "Import into Course:"),	1393	CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1131	CGI::td(	1394	CGI::td(
1132	CGI::scrolling_list(	1395	CGI::scrolling_list(
1133	-name => "import_courseID",	1396	-name => "import_courseID",
1134	-values => \@courseIDs,	1397	-values => \@courseIDs,
…		…
1137	-multiple => 0,	1400	-multiple => 0,
1138	-labels => \%courseLabels,	1401	-labels => \%courseLabels,
1139	),	1402	),
1140	),	1403	),
1141	),	1404	),
1142	CGI::Tr(	1405	CGI::Tr({},
1143	CGI::th({class=>"LeftHeader"}, "Conflicts:"),	1406	CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1144	CGI::td(	1407	CGI::td(
1145	CGI::radio_group(	1408	CGI::radio_group(
1146	-name => "import_conflict",	1409	-name => "import_conflict",
1147	-values => [qw/skip replace/],	1410	-values => [qw/skip replace/],
…		…
1154	),	1417	),
1155	),	1418	),
1156	),	1419	),
1157	);	1420	);
1158		1421
1159	print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));	1422	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"import_database", -value=>"Import Database"));
1160		1423
1161	print CGI::end_form();	1424	print CGI::end_form();
1162	}	1425	}
1163		1426
1164	sub import_database_validate {	1427	sub import_database_validate {
…		…
1175	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked	1438	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1176		1439
1177	my @errors;	1440	my @errors;
1178		1441
1179	if ($import_file eq "") {	1442	if ($import_file eq "") {
1180	push @errors, "You must specify a database file to upload.";	1443	push @errors, "You must specify a database file to import.";
1181	}	1444	}
1182		1445
1183	if ($import_courseID eq "") {	1446	if ($import_courseID eq "") {
1184	push @errors, "You must specify a course name.";	1447	push @errors, "You must specify a course name.";
1185	}	1448	}
…		…
1211	$import_courseID,	1474	$import_courseID,
1212	);	1475	);
1213		1476
1214	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1477	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1215		1478
		1479	# locate file
		1480	my $templateDir = $ce->{courseDirs}->{templates};
		1481	my $filePath = "$templateDir/$import_file";
		1482
		1483	my $gunzipMessage = system( 'gunzip', $filePath);
		1484	#FIXME
		1485	#warn "gunzip ", $gunzipMessage;
		1486	$filePath =~ s/\.gz$//;
		1487	#warn "new file path is $filePath";
		1488	my $fileHandle = new IO::File("<$filePath");
1216	# retrieve upload from upload cache	1489	# retrieve upload from upload cache
1217	my ($id, $hash) = split /\s+/, $import_file;	1490	# my ($id, $hash) = split /\s+/, $import_file;
1218	my $upload = WeBWorK::Upload->retrieve($id, $hash,	1491	# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1219	dir => $ce->{webworkDirs}->{uploadCache}	1492	# dir => $ce->{webworkDirs}->{uploadCache}
1220	);	1493	# );
1221		1494
1222	my @errors;	1495	my @errors;
1223		1496
1224	eval {	1497	eval {
1225	@errors = dbImport(	1498	@errors = dbImport(
1226	db => $db2,	1499	db => $db2,
1227	xml => $upload->fileHandle,	1500	# xml => $upload->fileHandle,
		1501	xml => $fileHandle,
1228	tables => \@import_tables,	1502	tables => \@import_tables,
1229	conflict => $import_conflict,	1503	conflict => $import_conflict,
1230	);	1504	);
1231	};	1505	};
1232		1506
1233	$upload->dispose;
1234
1235	push @errors, "Fatal exception: $@" if $@;	1507	push @errors, "Fatal exception: $@" if $@;
		1508	push @errors, $gunzipMessage if $gunzipMessage;
1236		1509
1237	if (@errors) {	1510	if (@errors) {
1238	print CGI::div({class=>"ResultsWithError"},	1511	print CGI::div({class=>"ResultsWithError"},
1239	CGI::p("An error occured while importing the database of course $import_courseID:"),	1512	CGI::p("An error occured while importing the database of course $import_courseID:"),
1240	CGI::ul(CGI::li(\@errors)),	1513	CGI::ul(CGI::li(\@errors)),
…		…
1243	print CGI::div({class=>"ResultsWithoutError"},	1516	print CGI::div({class=>"ResultsWithoutError"},
1244	CGI::p("Import succeeded."),	1517	CGI::p("Import succeeded."),
1245	);	1518	);
1246	}	1519	}
1247	}	1520	}
		1521	##########################################################################
		1522	sub archive_course_form {
		1523	my ($self) = @_;
		1524	my $r = $self->r;
		1525	my $ce = $r->ce;
		1526	#my $db = $r->db;
		1527	#my $authz = $r->authz;
		1528	#my $urlpath = $r->urlpath;
		1529
		1530	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1531
		1532	my @courseIDs = listCourses($ce);
		1533	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		1534
		1535	my %courseLabels; # records... heh.
		1536	foreach my $courseID (@courseIDs) {
		1537	my $tempCE = WeBWorK::CourseEnvironment->new(
		1538	$ce->{webworkDirs}->{root},
		1539	$ce->{webworkURLs}->{root},
		1540	$ce->{pg}->{directories}->{root},
		1541	$courseID,
		1542	);
		1543	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		1544	}
		1545
		1546	print CGI::h2("archive Course");
		1547
		1548	print CGI::start_form(-method=>"POST", -action=>$r->uri);
		1549	print $self->hidden_authen_fields;
		1550	print $self->hidden_fields("subDisplay");
		1551
		1552	print CGI::p("Select a course to archive.");
		1553
		1554	print CGI::table({class=>"FormLayout"},
		1555	CGI::Tr({},
		1556	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		1557	CGI::td(
		1558	CGI::scrolling_list(
		1559	-name => "archive_courseID",
		1560	-values => \@courseIDs,
		1561	-default => $archive_courseID,
		1562	-size => 10,
		1563	-multiple => 0,
		1564	-labels => \%courseLabels,
		1565	),
		1566	),
		1567
		1568	),
		1569	CGI::Tr({},
		1570	CGI::th({class=>"LeftHeader"}, "Delete course:"),
		1571	CGI::td({-style=>'color:red'}, CGI::checkbox({
		1572	-name=>'delete_course',
		1573	-checked=>0,
		1574	-value => 1,
		1575	-label =>'Delete course after archiving. Caution there is no undo!',
		1576	},
		1577	),
		1578	),
		1579	)
		1580	);
		1581
		1582	print CGI::p(
		1583	"Currently the archive facility is only available for mysql databases.
		1584	It depends on the mysqldump application."
		1585	);
1248		1586
		1587
		1588	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course", -value=>"archive Course"));
		1589
		1590	print CGI::end_form();
		1591	}
		1592
		1593	sub archive_course_validate {
		1594	my ($self) = @_;
		1595	my $r = $self->r;
		1596	my $ce = $r->ce;
		1597	#my $db = $r->db;
		1598	#my $authz = $r->authz;
		1599	my $urlpath = $r->urlpath;
		1600
		1601	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1602
		1603	my @errors;
		1604
		1605	if ($archive_courseID eq "") {
		1606	push @errors, "You must specify a course name.";
		1607	} elsif ($archive_courseID eq $urlpath->arg("courseID")) {
		1608	push @errors, "You cannot archive the course you are currently using.";
		1609	}
		1610
		1611	#my $ce2 = WeBWorK::CourseEnvironment->new(
		1612	# $ce->{webworkDirs}->{root},
		1613	# $ce->{webworkURLs}->{root},
		1614	# $ce->{pg}->{directories}->{root},
		1615	# $archive_courseID,
		1616	#);
		1617
		1618	return @errors;
		1619	}
		1620
		1621	sub archive_course_confirm {
		1622	my ($self) = @_;
		1623	my $r = $self->r;
		1624	my $ce = $r->ce;
		1625	#my $db = $r->db;
		1626	#my $authz = $r->authz;
		1627	#my $urlpath = $r->urlpath;
		1628
		1629	print CGI::h2("archive Course");
		1630
		1631	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1632	my $delete_course_flag = $r->param("delete_course") \|\| "";
		1633
		1634	my $ce2 = WeBWorK::CourseEnvironment->new(
		1635	$ce->{webworkDirs}->{root},
		1636	$ce->{webworkURLs}->{root},
		1637	$ce->{pg}->{directories}->{root},
		1638	$archive_courseID,
		1639	);
		1640
		1641	if ($ce2->{dbLayoutName} ) {
		1642	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
		1643	. "? ");
		1644	print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ".
		1645	CGI::b($archive_courseID). " after archiving? This cannot be undone!")) if $delete_course_flag;
		1646
		1647
		1648	}
		1649
		1650	print CGI::start_form(-method=>"POST", -action=>$r->uri);
		1651	print $self->hidden_authen_fields;
		1652	print $self->hidden_fields("subDisplay");
		1653	print $self->hidden_fields(qw/archive_courseID delete_course/);
		1654
		1655	print CGI::p({style=>"text-align: center"},
		1656	CGI::submit(-name=>"decline_archive_course", -value=>"Don't archive"),
		1657	" ",
		1658	CGI::submit(-name=>"confirm_archive_course", -value=>"archive"),
		1659	);
		1660
		1661	print CGI::end_form();
		1662	}
		1663
		1664	sub do_archive_course {
		1665	my ($self) = @_;
		1666	my $r = $self->r;
		1667	my $ce = $r->ce;
		1668	my $db = $r->db;
		1669	#my $authz = $r->authz;
		1670	#my $urlpath = $r->urlpath;
		1671
		1672	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1673	my $delete_course_flag = $r->param("delete_course") \|\| "";
		1674
		1675	my $ce2 = WeBWorK::CourseEnvironment->new(
		1676	$ce->{webworkDirs}->{root},
		1677	$ce->{webworkURLs}->{root},
		1678	$ce->{pg}->{directories}->{root},
		1679	$archive_courseID,
		1680	);
		1681
		1682	# this is kinda left over from when we had 'gdbm' and 'sql' database layouts
		1683	# below this line, we would grab values from getopt and put them in this hash
		1684	# but for now the hash can remain empty
		1685	my %dbOptions;
		1686
		1687	eval {
		1688	archiveCourse(
		1689	courseID => $archive_courseID,
		1690	ce => $ce2,
		1691	dbOptions => \%dbOptions,
		1692	);
		1693	};
		1694
		1695	if ($@) {
		1696	my $error = $@;
		1697	print CGI::div({class=>"ResultsWithError"},
		1698	CGI::p("An error occured while archiving the course $archive_courseID:"),
		1699	CGI::tt(CGI::escapeHTML($error)),
		1700	);
		1701	} else {
		1702	print CGI::div({class=>"ResultsWithoutError"},
		1703	CGI::p("Successfully archived the course $archive_courseID"),
		1704	);
		1705	writeLog($ce, "hosted_courses", join("\t",
		1706	"\tarchived",
		1707	"",
		1708	"",
		1709	$archive_courseID,
		1710	));
		1711
		1712	if ($delete_course_flag) {
		1713	eval {
		1714	deleteCourse(
		1715	courseID => $archive_courseID,
		1716	ce => $ce2,
		1717	dbOptions => \%dbOptions,
		1718	);
		1719	};
		1720
		1721	if ($@) {
		1722	my $error = $@;
		1723	print CGI::div({class=>"ResultsWithError"},
		1724	CGI::p("An error occured while deleting the course $archive_courseID:"),
		1725	CGI::tt(CGI::escapeHTML($error)),
		1726	);
		1727	} else {
		1728	# mark the contact person in the admin course as dropped.
		1729	# find the contact person for the course by searching the admin classlist.
		1730	my @contacts = grep /_$archive_courseID$/, $db->listUsers;
		1731	if (@contacts) {
		1732	die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1;
		1733	#warn "contacts", join(" ", @contacts);
		1734	#my $composite_id = "${add_initial_userID}_${add_courseID}";
		1735	my $composite_id = $contacts[0];
		1736
		1737	# mark the contact person as dropped.
		1738	my $User = $db->getUser($composite_id);
		1739	my $status_name = 'Drop';
		1740	my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
		1741	$User->status($status_value);
		1742	$db->putUser($User);
		1743	}
		1744
		1745	print CGI::div({class=>"ResultsWithoutError"},
		1746	CGI::p("Successfully deleted the course $archive_courseID."),
		1747	);
		1748	}
		1749
		1750
		1751	}
		1752
		1753	# print CGI::start_form(-method=>"POST", -action=>$r->uri);
		1754	# print $self->hidden_authen_fields;
		1755	# print $self->hidden_fields("subDisplay");
		1756	#
		1757	# print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),);
		1758	#
		1759	# print CGI::end_form();
		1760	}
		1761	}
		1762	##########################################################################
		1763	sub unarchive_course_form {
		1764	my ($self) = @_;
		1765	my $r = $self->r;
		1766	my $ce = $r->ce;
		1767	#my $db = $r->db;
		1768	#my $authz = $r->authz;
		1769	#my $urlpath = $r->urlpath;
		1770
		1771	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		1772
		1773	# First find courses which have been archived.
		1774	my @courseIDs = listArchivedCourses($ce);
		1775	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		1776
		1777	my %courseLabels; # records... heh.
		1778	foreach my $courseID (@courseIDs) {
		1779	$courseLabels{$courseID} = $courseID;
		1780	}
		1781
		1782	print CGI::h2("Unarchive Course -- not yet operational");
		1783
		1784	print CGI::start_form(-method=>"POST", -action=>$r->uri);
		1785	print $self->hidden_authen_fields;
		1786	print $self->hidden_fields("subDisplay");
		1787
		1788	print CGI::p("Select a course to unarchive.");
		1789
		1790	print CGI::table({class=>"FormLayout"},
		1791	CGI::Tr({},
		1792	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		1793	CGI::td(
		1794	CGI::scrolling_list(
		1795	-name => "unarchive_courseID",
		1796	-values => \@courseIDs,
		1797	-default => $unarchive_courseID,
		1798	-size => 10,
		1799	-multiple => 0,
		1800	-labels => \%courseLabels,
		1801	),
		1802	),
		1803	),
		1804	);
		1805
		1806	print CGI::p(
		1807	"Currently the unarchive facility is only available for mysql databases.
		1808	It depends on the mysqldump application."
		1809	);
		1810
		1811
		1812	print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course"));
		1813
		1814	print CGI::end_form();
		1815	}
		1816
		1817	sub unarchive_course_validate {
		1818	my ($self) = @_;
		1819	my $r = $self->r;
		1820	my $ce = $r->ce;
		1821	#my $db = $r->db;
		1822	#my $authz = $r->authz;
		1823	my $urlpath = $r->urlpath;
		1824
		1825	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		1826
		1827	my @errors;
		1828
		1829	my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
		1830
		1831	if ($new_courseID eq "") {
		1832	push @errors, "You must specify a course name.";
		1833	} elsif ( -d $ce->{webworkDirs}->{courses}."/$new_courseID" ) {
		1834	#Check that a directory for this course doesn't already exist
		1835	push @errors, "A directory already exists with the name $new_courseID.
		1836	You must first delete this existing course before you can unarchive.";
		1837	}
		1838
		1839
		1840
		1841	return @errors;
		1842	}
		1843
		1844	sub unarchive_course_confirm {
		1845	my ($self) = @_;
		1846	my $r = $self->r;
		1847	my $ce = $r->ce;
		1848	#my $db = $r->db;
		1849	#my $authz = $r->authz;
		1850	#my $urlpath = $r->urlpath;
		1851
		1852	print CGI::h2("Unarchive Course");
		1853
		1854	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		1855
		1856	my $new_courseID = $unarchive_courseID; $new_courseID =~ s/\.tar\.gz$//;
		1857
		1858
		1859
		1860	print CGI::start_form(-method=>"POST", -action=>$r->uri);
		1861	print CGI::p($unarchive_courseID," to course ",
		1862	CGI::input({-name=>'new_courseID', -value=>$new_courseID})
		1863	);
		1864
		1865	print $self->hidden_authen_fields;
		1866	print $self->hidden_fields("subDisplay");
		1867	print $self->hidden_fields(qw/unarchive_courseID/);
		1868
		1869	print CGI::p({style=>"text-align: center"},
		1870	CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"),
		1871	" ",
		1872	CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"),
		1873	);
		1874
		1875	print CGI::end_form();
		1876	}
		1877
		1878	sub do_unarchive_course {
		1879	my ($self) = @_;
		1880	my $r = $self->r;
		1881	my $ce = $r->ce;
		1882	#my $db = $r->db;
		1883	#my $authz = $r->authz;
		1884	my $urlpath = $r->urlpath;
		1885	my $new_courseID = $r->param("new_courseID") \|\| "";
		1886	my $unarchive_courseID = $r->param("unarchive_courseID") \|\| "";
		1887
		1888	my %dbOptions;
		1889
		1890	eval {
		1891	unarchiveCourse(
		1892	courseID => $new_courseID,
		1893	archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID",
		1894	ce => $ce , # $ce2,
		1895	dbOptions => undef,
		1896	);
		1897	};
		1898
		1899	if ($@) {
		1900	my $error = $@;
		1901	print CGI::div({class=>"ResultsWithError"},
		1902	CGI::p("An error occured while archiving the course $unarchive_courseID:"),
		1903	CGI::tt(CGI::escapeHTML($error)),
		1904	);
		1905	} else {
		1906	print CGI::div({class=>"ResultsWithoutError"},
		1907	CGI::p("Successfully unarchived $unarchive_courseID to the course $new_courseID"),
		1908	);
		1909	writeLog($ce, "hosted_courses", join("\t",
		1910	"\tunarchived",
		1911	"",
		1912	"",
		1913	"$unarchive_courseID to $new_courseID",
		1914	));
		1915
		1916	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
		1917	courseID => $new_courseID);
		1918	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
		1919	print CGI::div({style=>"text-align: center"},
		1920	CGI::a({href=>$newCourseURL}, "Log into $new_courseID"),
		1921	);
		1922	}
		1923	}
		1924
		1925	################################################################################
1249	1;	1926	1;

 Legend:



Removed from v.2299
 


changed lines


 
Added in v.4357
 Legend:



Removed from v.2299
 


changed lines


 
Added in v.4357
-Removed from v.2299
+Added in v.4357

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9