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

Revision 2299		Revision 3973
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.42 2005/11/07 21:20:57 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();
29	use Data::Dumper;	29	use Data::Dumper;
30	use File::Temp qw/tempfile/;	30	use File::Temp qw/tempfile/;
31	use WeBWorK::CourseEnvironment;	31	use WeBWorK::CourseEnvironment;
		32	use IO::File;
32	use WeBWorK::Utils qw(cryptPassword writeLog);	33	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
33	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);	34	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse);
34	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);	35	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
		36
		37	# put the following database layouts at the top of the list, in this order
		38	our @DB_LAYOUT_ORDER = qw/sql_single gdbm sql/;
		39
		40	our %DB_LAYOUT_DESCRIPTIONS = (
		41	gdbm => CGI::i("Deprecated. Uses GDBM databases to record WeBWorK data. Use this layout if the course must be used with WeBWorK 1.x."),
		42	sql => CGI::i("Deprecated. Uses a separate SQL database to record WeBWorK data for each course."),
		43	sql_single => "Uses a single SQL database to record WeBWorK data for all courses using this layout. This is the recommended layout for new courses.",
		44	);
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
		191	else {
		192	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
		193	}
		194
		195	}
		196
		197	$self->{errors} = \@errors;
		198	$self->{method_to_call} = $method_to_call;
		199	}
		200
		201	sub header {
		202	my ($self) = @_;
		203	my $method_to_call = $self->{method_to_call};
		204	# if (defined $method_to_call and $method_to_call eq "do_export_database") {
		205	# my $r = $self->r;
		206	# my $courseID = $r->param("export_courseID");
		207	# $r->content_type("application/octet-stream");
		208	# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
		209	# $r->send_http_header;
		210	# } else {
		211	$self->SUPER::header;
		212	# }
		213	}
		214
		215	# sends:
		216	#
		217	# HTTP/1.1 200 OK
		218	# Date: Fri, 09 Jul 2004 19:05:55 GMT
		219	# Server: Apache/1.3.27 (Unix) mod_perl/1.27
		220	# Content-Disposition: attachment; filename="mth143_database.xml"
		221	# Connection: close
		222	# Content-Type: application/octet-stream
		223
		224	sub content {
		225	my ($self) = @_;
		226	my $method_to_call = $self->{method_to_call};
		227	if (defined $method_to_call and $method_to_call eq "do_export_database") {
		228	#$self->do_export_database;
		229	$self->SUPER::content;
		230	} else {
		231	$self->SUPER::content;
62	}	232	}
63	}	233	}
64		234
65	sub body {	235	sub body {
66	my ($self) = @_;	236	my ($self) = @_;
…		…
68	my $ce = $r->ce;	238	my $ce = $r->ce;
69	my $db = $r->db;	239	my $db = $r->db;
70	my $authz = $r->authz;	240	my $authz = $r->authz;
71	my $urlpath = $r->urlpath;	241	my $urlpath = $r->urlpath;
72		242
73	my $user = $r->param('user');	243	my $user = $r->param('user');
74		244
75	# check permissions	245	# check permissions
76	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {	246	unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
77	return "";	247	return "";
78	}	248	}
		249	my $method_to_call = $self->{method_to_call};
		250	my $methodMessage ="";
		251
		252	(defined($method_to_call) and $method_to_call eq "do_export_database") && do {
		253	my @export_courseID = $r->param("export_courseID");
		254	my $course_ids = join(", ", @export_courseID);
		255	$methodMessage = CGI::p("Exporting database for course(s) $course_ids").
		256	CGI::p(".... please wait....
		257	If your browser times out you will
		258	still be able to download the exported database using the
		259	file manager.").CGI::hr();
		260	};
		261
79		262
80	print CGI::p({style=>"text-align: center"},	263	print CGI::p({style=>"text-align: center"},
81	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),	264	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
		265	add_dbLayout=>'sql_single',
		266	add_templates_course => $ce->{siteDefaults}->{default_templates_course} \|\|""}
		267	)},
		268	"Add Course"
		269	),
82	#" \| ",	270	" \| ",
83	#CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),	271	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
84	" \| ",	272	" \| ",
85	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),	273	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
86	" \| ",	274	" \| ",
87	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),	275	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
88	" \| ",	276	" \| ",
89	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),	277	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
		278	" \| ",
		279	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
		280	CGI::hr(),
		281	$methodMessage,
		282
90	);	283	);
91		284
92	print CGI::hr();	285	print CGI::p("The ability to import and to export databases is still under development.
		286	It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
		287	use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
		288	Please send bug reports if you find errors. ");
93		289
94	my $subDisplay = $r->param("subDisplay");	290	my @errors = @{$self->{errors}};
95	if (defined $subDisplay) {
96		291
97	if ($subDisplay eq "add_course") {	292
98	if (defined $r->param("add_course")) {
99	my @errors = $self->add_course_validate;
100	if (@errors) {	293	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"},	294	print CGI::div({class=>"ResultsWithError"},
181	"Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.");	295	CGI::p("Please correct the following errors and try again:"),
		296	CGI::ul(CGI::li(\@errors)),
		297	);
182	}	298	}
		299
		300	if (defined $method_to_call and $method_to_call ne "") {
		301	$self->$method_to_call;
		302	} else {
		303
		304	print CGI::h2("Courses");
		305
		306	print CGI::start_ol();
		307
		308	my @courseIDs = listCourses($ce);
		309	foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
		310	next if $courseID eq "admin"; # done already above
		311	my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
		312	my $tempCE = WeBWorK::CourseEnvironment->new(
		313	$ce->{webworkDirs}->{root},
		314	$ce->{webworkURLs}->{root},
		315	$ce->{pg}->{directories}->{root},
		316	$courseID,
		317	);
		318	print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
		319	CGI::code(
		320	$tempCE->{dbLayoutName},
		321	),
		322	(-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"),
183		323
		324	);
		325
184	}	326	}
185		327
		328	print CGI::end_ol();
		329	}
186	return "";	330	return "";
187	}	331	}
188		332
189	################################################################################	333	################################################################################
190		334
…		…
195	#my $db = $r->db;	339	#my $db = $r->db;
196	#my $authz = $r->authz;	340	#my $authz = $r->authz;
197	#my $urlpath = $r->urlpath;	341	#my $urlpath = $r->urlpath;
198		342
199	my $add_courseID = $r->param("add_courseID") \|\| "";	343	my $add_courseID = $r->param("add_courseID") \|\| "";
		344	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
		345	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
		346
		347	my $add_admin_users = $r->param("add_admin_users") \|\| "";
		348
		349	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
		350	my $add_initial_password = $r->param("add_initial_password") \|\| "";
		351	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		352	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		353	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
		354	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		355
		356	my $add_templates_course = $r->param("add_templates_course") \|\| "";
		357
200	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	358	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
201	my $add_sql_host = $r->param("add_sql_host") \|\| "";	359	my $add_sql_host = $r->param("add_sql_host") \|\| "";
202	my $add_sql_port = $r->param("add_sql_port") \|\| "";	360	my $add_sql_port = $r->param("add_sql_port") \|\| "";
203	my $add_sql_username = $r->param("add_sql_username") \|\| "";	361	my $add_sql_username = $r->param("add_sql_username") \|\| "";
204	my $add_sql_password = $r->param("add_sql_password") \|\| "";	362	my $add_sql_password = $r->param("add_sql_password") \|\| "";
205	my $add_sql_database = $r->param("add_sql_database") \|\| "";	363	my $add_sql_database = $r->param("add_sql_database") \|\| "";
206	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	364	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
207	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	365	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
208	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
209	my $add_initial_password = $r->param("add_initial_password") \|\| "";
210	my $add_initial_password_confirm = $r->param("add_initial_password_confirm") \|\| "";
211	my $add_feedback_email = $r->param("add_feedback_email") \|\| "";
212	my $add_templates_course = $r->param("add_templates_course") \|\| "";
213	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";
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") \|\| "";
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		366
221	my @dbLayouts = sort keys %{ $ce->{dbLayouts} };	367	my @dbLayouts = do {
		368	my @ordered_layouts;
		369	foreach my $layout (@DB_LAYOUT_ORDER) {
		370	if (exists $ce->{dbLayouts}->{$layout}) {
		371	push @ordered_layouts, $layout;
		372	}
		373	}
		374
		375	my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
		376	my @other_layouts;
		377	foreach my $layout (keys %{ $ce->{dbLayouts} }) {
		378	unless (exists $ordered_layouts{$layout}) {
		379	push @other_layouts, $layout;
		380	}
		381	}
		382
		383	(@ordered_layouts, @other_layouts);
		384	};
222		385
223	my $ce2 = WeBWorK::CourseEnvironment->new(	386	my $ce2 = WeBWorK::CourseEnvironment->new(
224	$ce->{webworkDirs}->{root},	387	$ce->{webworkDirs}->{root},
225	$ce->{webworkURLs}->{root},	388	$ce->{webworkURLs}->{root},
226	$ce->{pg}->{directories}->{root},	389	$ce->{pg}->{directories}->{root},
…		…
244	}	407	}
245	$source;	408	$source;
246	};	409	};
247		410
248	my @existingCourses = listCourses($ce);	411	my @existingCourses = listCourses($ce);
		412	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
249		413
250	print CGI::h2("Add Course");	414	print CGI::h2("Add Course");
251		415
252	print CGI::start_form("POST", $r->uri);	416	print CGI::start_form("POST", $r->uri);
253	print $self->hidden_authen_fields;	417	print $self->hidden_authen_fields;
254	print $self->hidden_fields("subDisplay");	418	print $self->hidden_fields("subDisplay");
255		419
256	print CGI::p("Specify a name for the new course.");	420	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		421
258	print CGI::table({class=>"FormLayout"},	422	print CGI::table({class=>"FormLayout"},
259	CGI::Tr(	423	CGI::Tr(
260	CGI::th({class=>"LeftHeader"}, "Course ID:"),	424	CGI::th({class=>"LeftHeader"}, "Course ID:"),
261	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),	425	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
262	CGI::th({class=>"LeftHeader"}, "Course Title"),
263	CGI::td(CGI::textfield("add_course_title", $add_course_title, 25)),
264	),	426	),
265	);
266
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.");
268
269	print CGI::table({class=>"FormLayout"},
270	CGI::Tr(	427	CGI::Tr(
		428	CGI::th({class=>"LeftHeader"}, "Course Title:"),
		429	CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)),
		430	),
		431	CGI::Tr(
271	CGI::th({class=>"CenterHeader"}, "Instructor ID"),	432	CGI::th({class=>"LeftHeader"}, "Institution:"),
		433	CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
		434	),
		435	);
		436
		437	print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
		438	my $checked = ($add_admin_users) ?"checked": ""; # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
		439	print CGI::p(CGI::input({-type=>'checkbox', -name=>"add_admin_users", $checked=>'' }, "Add WeBWorK administrators to new course"));
		440
		441	print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only numbers, letters, hyphens, and underscores.");
		442
		443	print CGI::table({class=>"FormLayout"}, CGI::Tr(
		444	CGI::td(
		445	CGI::table({class=>"FormLayout"},
		446	CGI::Tr(
		447	CGI::th({class=>"LeftHeader"}, "User ID:"),
		448	CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)),
		449	),
		450	CGI::Tr(
272	CGI::th({class=>"CenterHeader"}, "Instructor Password"),	451	CGI::th({class=>"LeftHeader"}, "Password:"),
		452	CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
		453	),
		454	CGI::Tr(
273	CGI::th({class=>"CenterHeader"}, "Confirm Instructor Password"),	455	CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
		456	CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)),
		457	),
		458	),
		459	),
		460	CGI::td(
		461	CGI::table({class=>"FormLayout"},
		462	CGI::Tr(
		463	CGI::th({class=>"LeftHeader"}, "First Name:"),
		464	CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)),
		465	),
		466	CGI::Tr(
		467	CGI::th({class=>"LeftHeader"}, "Last Name:"),
		468	CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)),
		469	),
		470	CGI::Tr(
		471	CGI::th({class=>"LeftHeader"}, "Email Address:"),
		472	CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)),
		473	),
		474	),
274		475
275
276	),	476	),
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	);	477	));
317		478
318	print CGI::p("Select an existing course from which to copy templates:");	479	print CGI::p("To copy problem templates from an existing course, select the course below.");
319		480
320	print CGI::table({class=>"FormLayout"},	481	print CGI::table({class=>"FormLayout"},
321	CGI::Tr(	482	CGI::Tr(
322	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),	483	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
323	CGI::td(	484	CGI::td(
…		…
332		493
333	),	494	),
334	),	495	),
335	);	496	);
336		497
337	print CGI::p("Select a database layout below. Some database layouts require additional information.");	498	print CGI::p("Select a database layout below.");
338
339	#print CGI::start_Tr();
340	#print CGI::th({class=>"LeftHeader"}, "Database Layout:");
341	#print CGI::start_td();
342		499
343	foreach my $dbLayout (@dbLayouts) {	500	foreach my $dbLayout (@dbLayouts) {
344	print CGI::start_table({class=>"FormLayout"});	501	print CGI::start_table({class=>"FormLayout"});
		502
		503	my $dbLayoutLabel = (defined $DB_LAYOUT_DESCRIPTIONS{$dbLayout})
		504	? "$dbLayout - $DB_LAYOUT_DESCRIPTIONS{$dbLayout}"
		505	: $dbLayout;
345		506
346	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm	507	# we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
347	print CGI::Tr(	508	print CGI::Tr(
348	CGI::td({style=>"text-align: right"},	509	CGI::td({style=>"text-align: right"},
349	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'	510	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
350	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',	511	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
351	),	512	),
352	CGI::td($dbLayout),	513	CGI::td($dbLayoutLabel),
353	);	514	);
354		515
355	print CGI::start_Tr();	516	print CGI::start_Tr();
356	print CGI::td(); # for indentation :(	517	print CGI::td(); # for indentation :(
357	print CGI::start_td();	518	print CGI::start_td();
358		519
		520
359	if ($dbLayout eq "sql") {	521	if ($dbLayout eq "sql") {
360		522
		523	print CGI::p({style=>'font-style:italic'},"The following information is only required for the deprecated sql database format:");
361	print CGI::start_table({class=>"FormLayout"});	524	print CGI::start_table({class=>"FormLayout"});
362	print CGI::Tr(CGI::td({colspan=>2},	525	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."	526	"Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
364	)	527	)
365	);	528	);
366	print CGI::Tr(	529	print CGI::Tr(
367	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),	530	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
368	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),	531	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
…		…
370	print CGI::Tr(	533	print CGI::Tr(
371	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),	534	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
372	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),	535	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
373	);	536	);
374		537
375	print CGI::Tr(CGI::td({colspan=>2}, CGI::hr(),	538	print CGI::Tr(CGI::td({colspan=>2},
376	"The optionial SQL settings you enter below must match the settings in the DBI source",	539	"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"),	540	. " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
378	" with the course name you entered above."	541	. " with the course name you entered above."
379	)	542	)
380	);	543	);
381	print CGI::Tr(	544	print CGI::Tr(
382	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),	545	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
383	CGI::td(	546	CGI::td(
…		…
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."),	574	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	),	575	),
413	);	576	);
414	print CGI::end_table();	577	print CGI::end_table();
415	} elsif ($dbLayout eq "gdbm") {	578	} elsif ($dbLayout eq "gdbm") {
		579	print CGI::p({style=>"font-style: italic"},"The following information is only required for the deprecated gdbm database format:");
416	print CGI::start_table({class=>"FormLayout"});	580	print CGI::start_table({class=>"FormLayout"});
417	print CGI::Tr(	581	print CGI::Tr(
418	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),	582	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
419	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),	583	CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID \|\| "global_user", 25)),
420	);	584	);
…		…
424	print CGI::end_td();	588	print CGI::end_td();
425	print CGI::end_Tr();	589	print CGI::end_Tr();
426	print CGI::end_table();	590	print CGI::end_table();
427	}	591	}
428		592
429
430
431
432
433
434
435	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));	593	print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
436		594
437	print CGI::end_form();	595	print CGI::end_form();
438	}	596	}
439		597
…		…
444	#my $db = $r->db;	602	#my $db = $r->db;
445	#my $authz = $r->authz;	603	#my $authz = $r->authz;
446	#my $urlpath = $r->urlpath;	604	#my $urlpath = $r->urlpath;
447		605
448	my $add_courseID = $r->param("add_courseID") \|\| "";	606	my $add_courseID = $r->param("add_courseID") \|\| "";
		607	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
		608	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
		609
		610	my $add_admin_users = $r->param("add_admin_users") \|\| "";
		611
		612	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
		613	my $add_initial_password = $r->param("add_initial_password") \|\| "";
		614	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		615	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		616	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
		617	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		618
		619	my $add_templates_course = $r->param("add_templates_course") \|\| "";
		620
449	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	621	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
450	my $add_sql_host = $r->param("add_sql_host") \|\| "";	622	my $add_sql_host = $r->param("add_sql_host") \|\| "";
451	my $add_sql_port = $r->param("add_sql_port") \|\| "";	623	my $add_sql_port = $r->param("add_sql_port") \|\| "";
452	my $add_sql_username = $r->param("add_sql_username") \|\| "";	624	my $add_sql_username = $r->param("add_sql_username") \|\| "";
453	my $add_sql_password = $r->param("add_sql_password") \|\| "";	625	my $add_sql_password = $r->param("add_sql_password") \|\| "";
454	my $add_sql_database = $r->param("add_sql_database") \|\| "";	626	my $add_sql_database = $r->param("add_sql_database") \|\| "";
455	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	627	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
456	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	628	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
457	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";	629
458	my $add_initial_password = $r->param("add_initial_password") \|\| "";
459	my $add_initial_password_confirm = $r->param("add_initial_password_confirm") \|\| "";
460	my $add_templates_course = $r->param("add_templates_course") \|\| "";
461	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";
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") \|\| "";
466	my $add_admin_userID = $r->param("add_admin_userID") \|\| "";
467	my $add_admin_password = $r->param("add_admin_password") \|\| "";
468
469	my @errors;	630	my @errors;
470		631
471	if ($add_courseID eq "") {	632	if ($add_courseID eq "") {
472	push @errors, "You must specify a course name.";	633	push @errors, "You must specify a course ID.";
473	}	634	}
474	if ($add_contact_institution eq "") {	635	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
475	push @errors, "You must specify a contact institution." ;	636	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
476	}	637	}
477	if ($add_contact_last_name eq "") {	638	if (grep { $add_courseID eq $_ } listCourses($ce)) {
478	push @errors, "You must specify a contact person.";	639	push @errors, "A course with ID $add_courseID already exists.";
479	}	640	}
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 "") {	641	if ($add_courseTitle eq "") {
		642	push @errors, "You must specify a course title.";
		643	}
		644	if ($add_courseInstitution eq "") {
487	push @errors, "You must specify a title for the course.";	645	push @errors, "You must specify an institution for this course.";
		646	}
		647
		648	if ($add_initial_userID ne "") {
		649	if ($add_initial_password eq "") {
		650	push @errors, "You must specify a password for the initial instructor.";
		651	}
		652	if ($add_initial_confirmPassword eq "") {
		653	push @errors, "You must confirm the password for the initial instructor.";
		654	}
		655	if ($add_initial_password ne $add_initial_confirmPassword) {
		656	push @errors, "The password and password confirmation for the instructor must match.";
		657	}
		658	if ($add_initial_firstName eq "") {
		659	push @errors, "You must specify a first name for the initial instructor.";
		660	}
		661	if ($add_initial_lastName eq "") {
		662	push @errors, "You must specify a last name for the initial instructor.";
		663	}
		664	if ($add_initial_email eq "") {
		665	push @errors, "You must specify an email address for the initial instructor.";
		666	}
488	}	667	}
489		668
490	if ($add_dbLayout eq "") {	669	if ($add_dbLayout eq "") {
491	push @errors, "You must select a database layout.";	670	push @errors, "You must select a database layout.";
492	} else {	671	} else {
493	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {	672	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
494	if ($add_dbLayout eq "sql") {	673	if ($add_dbLayout eq "sql") {
495	push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";	674	push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
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 "";	675	push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
499	} elsif ($add_dbLayout eq "gdbm") {	676	} elsif ($add_dbLayout eq "gdbm") {
500	push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";	677	push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
501	}	678	}
502	} else {	679	} else {
503	push @errors, "The database layout $add_dbLayout doesn't exist.";	680	push @errors, "The database layout $add_dbLayout doesn't exist.";
504	}	681	}
505	}	682	}
506		683
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;	684	return @errors;
516	}	685	}
517		686
518	sub do_add_course {	687	sub do_add_course {
519	my ($self) = @_;	688	my ($self) = @_;
…		…
521	my $ce = $r->ce;	690	my $ce = $r->ce;
522	my $db = $r->db;	691	my $db = $r->db;
523	#my $authz = $r->authz;	692	#my $authz = $r->authz;
524	my $urlpath = $r->urlpath;	693	my $urlpath = $r->urlpath;
525		694
526	my $add_courseID = $r->param("add_courseID") \|\| "";	695	my $add_courseID = $r->param("add_courseID") \|\| "";
		696	my $add_courseTitle = $r->param("add_courseTitle") \|\| "";
		697	my $add_courseInstitution = $r->param("add_courseInstitution") \|\| "";
		698
		699	my $add_admin_users = $r->param("add_admin_users") \|\| "";
		700
		701	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
		702	my $add_initial_password = $r->param("add_initial_password") \|\| "";
		703	my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") \|\| "";
		704	my $add_initial_firstName = $r->param("add_initial_firstName") \|\| "";
		705	my $add_initial_lastName = $r->param("add_initial_lastName") \|\| "";
		706	my $add_initial_email = $r->param("add_initial_email") \|\| "";
		707
		708	my $add_templates_course = $r->param("add_templates_course") \|\| "";
		709
527	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	710	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
528	my $add_sql_host = $r->param("add_sql_host") \|\| "";	711	my $add_sql_host = $r->param("add_sql_host") \|\| "";
529	my $add_sql_port = $r->param("add_sql_port") \|\| "";	712	my $add_sql_port = $r->param("add_sql_port") \|\| "";
530	my $add_sql_username = $r->param("add_sql_username") \|\| "";	713	my $add_sql_username = $r->param("add_sql_username") \|\| "";
531	my $add_sql_password = $r->param("add_sql_password") \|\| "";	714	my $add_sql_password = $r->param("add_sql_password") \|\| "";
532	my $add_sql_database = $r->param("add_sql_database") \|\| "";	715	my $add_sql_database = $r->param("add_sql_database") \|\| "";
533	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	716	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
534	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	717	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
535	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
536	my $add_initial_password = $r->param("add_initial_password") \|\| "";
537	my $add_templates_course = $r->param("add_templates_course") \|\| "";
538	my $add_contact_first_name = $r->param("add_contact_first_name") \|\| "";
539	my $add_contact_last_name = $r->param("add_contact_last_name") \|\| "";
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		718
546	my $ce2 = WeBWorK::CourseEnvironment->new(	719	my $ce2 = WeBWorK::CourseEnvironment->new(
547	$ce->{webworkDirs}->{root},	720	$ce->{webworkDirs}->{root},
548	$ce->{webworkURLs}->{root},	721	$ce->{webworkURLs}->{root},
549	$ce->{pg}->{directories}->{root},	722	$ce->{pg}->{directories}->{root},
550	$add_courseID,	723	$add_courseID,
551	);	724	);
552		725
553	my %courseOptions = ( dbLayoutName => $add_dbLayout );	726	my %courseOptions = ( dbLayoutName => $add_dbLayout );
		727
		728	if ($add_initial_email ne "") {
		729	$courseOptions{allowedRecipients} = [ $add_initial_email ];
		730	# don't set feedbackRecipients -- this just gets in the way of the more
		731	# intelligent "receive_recipients" method.
		732	#$courseOptions{feedbackRecipients} = [ $add_initial_email ];
		733	}
		734
554	if ($add_dbLayout eq "gdbm") {	735	if ($add_dbLayout eq "gdbm") {
555	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";	736	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
556	}	737	}
557		738
558	my %dbOptions;	739	my %dbOptions;
…		…
562	$dbOptions{username} = $add_sql_username;	743	$dbOptions{username} = $add_sql_username;
563	$dbOptions{password} = $add_sql_password;	744	$dbOptions{password} = $add_sql_password;
564	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";	745	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";
565	$dbOptions{wwhost} = $add_sql_wwhost;	746	$dbOptions{wwhost} = $add_sql_wwhost;
566	}	747	}
567	# add professor and administor if defined.	748
568	my @users;	749	my @users;
		750
		751	# copy users from current (admin) course if desired
		752	if ($add_admin_users ne "") {
		753	foreach my $userID ($db->listUsers) {
		754	if ($userID eq $add_initial_userID) {
		755	$self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
		756	next;
		757	}
		758	my $User = $db->getUser($userID);
		759	my $Password = $db->getPassword($userID);
		760	my $PermissionLevel = $db->getPermissionLevel($userID);
		761	push @users, [ $User, $Password, $PermissionLevel ];
		762	}
		763	}
		764
		765	# add initial instructor if desired
569	if ($add_initial_userID ne "") {	766	if ($add_initial_userID ne "") {
570	my $User = $db->newUser(	767	my $User = $db->newUser(
571	user_id => $add_initial_userID,	768	user_id => $add_initial_userID,
		769	first_name => $add_initial_firstName,
		770	last_name => $add_initial_lastName,
		771	student_id => $add_initial_userID,
		772	email_address => $add_initial_email,
572	status => "C",	773	status => "C",
573	);	774	);
574	my $Password = $db->newPassword(	775	my $Password = $db->newPassword(
575	user_id => $add_initial_userID,	776	user_id => $add_initial_userID,
576	password => cryptPassword($add_initial_password),	777	password => cryptPassword($add_initial_password),
577	);	778	);
578	my $PermissionLevel = $db->newPermissionLevel(	779	my $PermissionLevel = $db->newPermissionLevel(
579	user_id => $add_initial_userID,	780	user_id => $add_initial_userID,
580	permission => "10",	781	permission => "10",
581	);	782	);
582	push @users, [ $User, $Password, $PermissionLevel ];	783	push @users, [ $User, $Password, $PermissionLevel ];
583	}	784	}
584	if ($add_admin_userID ne "") {	785
585	my $User = $db->newUser(	786	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
586	user_id => $add_admin_userID,	787
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;	788	my %optional_arguments;
600	if ($add_templates_course ne "") {	789	if ($add_templates_course ne "") {
601	$optional_arguments{templatesFrom} = $add_templates_course;	790	$optional_arguments{templatesFrom} = $add_templates_course;
602	}	791	}
603		792
…		…
609	dbOptions => \%dbOptions,	798	dbOptions => \%dbOptions,
610	users => \@users,	799	users => \@users,
611	%optional_arguments,	800	%optional_arguments,
612	);	801	);
613	};	802	};
614
615	if ($@) {	803	if ($@) {
616	my $error = $@;	804	my $error = $@;
617	print CGI::div({class=>"ResultsWithError"},	805	print CGI::div({class=>"ResultsWithError"},
618	CGI::p("An error occured while creating the course $add_courseID:"),	806	CGI::p("An error occured while creating the course $add_courseID:"),
619	CGI::tt(CGI::escapeHTML($error)),	807	CGI::tt(CGI::escapeHTML($error)),
…		…
631	}	819	}
632	} else {	820	} else {
633	#log the action	821	#log the action
634	writeLog($ce, "hosted_courses", join("\t",	822	writeLog($ce, "hosted_courses", join("\t",
635	"\tAdded",	823	"\tAdded",
636	$add_contact_institution,	824	$add_courseInstitution,
637	$add_course_title,	825	$add_courseTitle,
638	$add_courseID,	826	$add_courseID,
639	$add_contact_first_name,	827	$add_initial_firstName,
640	$add_contact_last_name,	828	$add_initial_lastName,
641	$add_contact_email,	829	$add_initial_email,
642	));	830	));
643	# add contact to admin course as student?	831	# add contact to admin course as student?
644	# FIXME -- should we do this?	832	# FIXME -- should we do this?
645	print CGI::div({class=>"ResultsWithoutError"},	833	print CGI::div({class=>"ResultsWithoutError"},
646	CGI::p("Successfully created the course $add_courseID"),	834	CGI::p("Successfully created the course $add_courseID"),
…		…
650	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);	838	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
651	print CGI::div({style=>"text-align: center"},	839	print CGI::div({style=>"text-align: center"},
652	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),	840	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
653	);	841	);
654	}	842	}
		843
655		844
		845	}
		846
		847	################################################################################
		848
		849	sub rename_course_form {
		850	my ($self) = @_;
		851	my $r = $self->r;
		852	my $ce = $r->ce;
		853	#my $db = $r->db;
		854	#my $authz = $r->authz;
		855	#my $urlpath = $r->urlpath;
		856
		857	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		858	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		859
		860	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		861	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		862	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		863	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		864	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		865	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		866	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		867
		868	my @courseIDs = listCourses($ce);
		869	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
		870
		871	my %courseLabels; # records... heh.
		872	foreach my $courseID (@courseIDs) {
		873	my $tempCE = WeBWorK::CourseEnvironment->new(
		874	$ce->{webworkDirs}->{root},
		875	$ce->{webworkURLs}->{root},
		876	$ce->{pg}->{directories}->{root},
		877	$courseID,
		878	);
		879	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		880	}
		881
		882	print CGI::h2("Rename Course");
		883
		884	print CGI::start_form("POST", $r->uri);
		885	print $self->hidden_authen_fields;
		886	print $self->hidden_fields("subDisplay");
		887
		888	print CGI::p("Select a course to rename.");
		889
		890	print CGI::table({class=>"FormLayout"},
		891	CGI::Tr(
		892	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		893	CGI::td(
		894	CGI::scrolling_list(
		895	-name => "rename_oldCourseID",
		896	-values => \@courseIDs,
		897	-default => $rename_oldCourseID,
		898	-size => 10,
		899	-multiple => 0,
		900	-labels => \%courseLabels,
		901	),
		902	),
		903	),
		904	CGI::Tr(
		905	CGI::th({class=>"LeftHeader"}, "New Name:"),
		906	CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
		907	),
		908	);
		909
		910	print CGI::p(
		911	"If the course's database layout (indicated in parentheses above) is "
		912	. CGI::b("sql") . ", supply the SQL connections information requested below."
		913	);
		914
		915	print CGI::start_table({class=>"FormLayout"});
		916	print CGI::Tr(CGI::td({colspan=>2},
		917	"Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
		918	)
		919	);
		920	print CGI::Tr(
		921	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		922	CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
		923	);
		924	print CGI::Tr(
		925	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		926	CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
		927	);
		928
		929	print CGI::Tr(
		930	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
		931	CGI::td(
		932	CGI::textfield("rename_sql_host", $rename_sql_host, 25),
		933	CGI::br(),
		934	CGI::small("Leave blank to use the default host."),
		935	),
		936	);
		937	print CGI::Tr(
		938	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
		939	CGI::td(
		940	CGI::textfield("rename_sql_port", $rename_sql_port, 25),
		941	CGI::br(),
		942	CGI::small("Leave blank to use the default port."),
		943	),
		944	);
		945
		946	print CGI::Tr(
		947	CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
		948	CGI::td(
		949	CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
		950	CGI::br(),
		951	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
		952	),
		953	);
		954	print CGI::Tr(
		955	CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
		956	CGI::td(
		957	CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
		958	CGI::br(),
		959	CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
		960	),
		961	);
		962	print CGI::Tr(
		963	CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
		964	CGI::td(
		965	CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost \|\| "localhost", 25),
		966	CGI::br(),
		967	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."),
		968	),
		969	);
		970	print CGI::end_table();
		971
		972	print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
		973
		974	print CGI::end_form();
		975	}
		976
		977	sub rename_course_validate {
		978	my ($self) = @_;
		979	my $r = $self->r;
		980	my $ce = $r->ce;
		981	#my $db = $r->db;
		982	#my $authz = $r->authz;
		983	#my $urlpath = $r->urlpath;
		984
		985	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		986	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		987
		988	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		989	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		990	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		991	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		992	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		993	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		994	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		995
		996	my @errors;
		997
		998	if ($rename_oldCourseID eq "") {
		999	push @errors, "You must select a course to rename.";
		1000	}
		1001	if ($rename_newCourseID eq "") {
		1002	push @errors, "You must specify a new name for the course.";
		1003	}
		1004	if ($rename_oldCourseID eq $rename_newCourseID) {
		1005	push @errors, "Can't rename to the same name.";
		1006	}
		1007	unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
		1008	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
		1009	}
		1010	if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
		1011	push @errors, "A course with ID $rename_newCourseID already exists.";
		1012	}
		1013
		1014	my $ce2 = WeBWorK::CourseEnvironment->new(
		1015	$ce->{webworkDirs}->{root},
		1016	$ce->{webworkURLs}->{root},
		1017	$ce->{pg}->{directories}->{root},
		1018	$rename_oldCourseID,
		1019	);
		1020
		1021	if ($ce2->{dbLayoutName} eq "sql") {
		1022	push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
		1023	#push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
		1024	#push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
		1025	#push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
		1026	}
		1027
		1028	return @errors;
		1029	}
		1030
		1031	sub do_rename_course {
		1032	my ($self) = @_;
		1033	my $r = $self->r;
		1034	my $ce = $r->ce;
		1035	my $db = $r->db;
		1036	#my $authz = $r->authz;
		1037	my $urlpath = $r->urlpath;
		1038
		1039	my $rename_oldCourseID = $r->param("rename_oldCourseID") \|\| "";
		1040	my $rename_newCourseID = $r->param("rename_newCourseID") \|\| "";
		1041
		1042	my $rename_sql_host = $r->param("rename_sql_host") \|\| "";
		1043	my $rename_sql_port = $r->param("rename_sql_port") \|\| "";
		1044	my $rename_sql_username = $r->param("rename_sql_username") \|\| "";
		1045	my $rename_sql_password = $r->param("rename_sql_password") \|\| "";
		1046	my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") \|\| "";
		1047	my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") \|\| "";
		1048	my $rename_sql_wwhost = $r->param("rename_sql_wwhost") \|\| "";
		1049
		1050	my $ce2 = WeBWorK::CourseEnvironment->new(
		1051	$ce->{webworkDirs}->{root},
		1052	$ce->{webworkURLs}->{root},
		1053	$ce->{pg}->{directories}->{root},
		1054	$rename_oldCourseID,
		1055	);
		1056
		1057	my $dbLayoutName = $ce->{dbLayoutName};
		1058
		1059	my %dbOptions;
		1060	if ($dbLayoutName eq "sql") {
		1061	$dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
		1062	$dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
		1063	$dbOptions{username} = $rename_sql_username;
		1064	$dbOptions{password} = $rename_sql_password;
		1065	$dbOptions{old_database} = $rename_sql_oldDatabase \|\| "webwork_$rename_oldCourseID";
		1066	$dbOptions{new_database} = $rename_sql_newDatabase \|\| "webwork_$rename_newCourseID";
		1067	$dbOptions{wwhost} = $rename_sql_wwhost;
		1068	}
		1069
		1070	eval {
		1071	renameCourse(
		1072	courseID => $rename_oldCourseID,
		1073	ce => $ce2,
		1074	dbOptions => \%dbOptions,
		1075	newCourseID => $rename_newCourseID,
		1076	);
		1077	};
		1078	if ($@) {
		1079	my $error = $@;
		1080	print CGI::div({class=>"ResultsWithError"},
		1081	CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
		1082	CGI::tt(CGI::escapeHTML($error)),
		1083	);
		1084	} else {
		1085	print CGI::div({class=>"ResultsWithoutError"},
		1086	CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
		1087	);
		1088	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
		1089	courseID => $rename_newCourseID);
		1090	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
		1091	print CGI::div({style=>"text-align: center"},
		1092	CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
		1093	);
		1094	}
656	}	1095	}
657		1096
658	################################################################################	1097	################################################################################
659		1098
660	sub delete_course_form {	1099	sub delete_course_form {
…		…
671	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";	1110	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
672	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";	1111	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
673	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";	1112	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
674		1113
675	my @courseIDs = listCourses($ce);	1114	my @courseIDs = listCourses($ce);
676	@courseIDs = sort @courseIDs;	1115	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
677		1116
678	my %courseLabels; # records... heh.	1117	my %courseLabels; # records... heh.
679	foreach my $courseID (@courseIDs) {	1118	foreach my $courseID (@courseIDs) {
680	my $tempCE = WeBWorK::CourseEnvironment->new(	1119	my $tempCE = WeBWorK::CourseEnvironment->new(
681	$ce->{webworkDirs}->{root},	1120	$ce->{webworkDirs}->{root},
…		…
714	"If the course's database layout (indicated in parentheses above) is "	1153	"If the course's database layout (indicated in parentheses above) is "
715	. CGI::b("sql") . ", supply the SQL connections information requested below."	1154	. CGI::b("sql") . ", supply the SQL connections information requested below."
716	);	1155	);
717		1156
718	print CGI::start_table({class=>"FormLayout"});	1157	print CGI::start_table({class=>"FormLayout"});
		1158	print CGI::Tr(CGI::td({colspan=>2},
		1159	"Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database."
		1160	)
		1161	);
		1162	print CGI::Tr(
		1163	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		1164	CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
		1165	);
		1166	print CGI::Tr(
		1167	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		1168	CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
		1169	);
		1170
		1171	#print CGI::Tr(CGI::td({colspan=>2},
		1172	# "The optionial SQL settings you enter below must match the settings in the DBI source"
		1173	# . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
		1174	# . " with the course name you entered above."
		1175	# )
		1176	#);
719	print CGI::Tr(	1177	print CGI::Tr(
720	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),	1178	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
721	CGI::td(	1179	CGI::td(
722	CGI::textfield("delete_sql_host", $delete_sql_host, 25),	1180	CGI::textfield("delete_sql_host", $delete_sql_host, 25),
723	CGI::br(),	1181	CGI::br(),
…		…
730	CGI::textfield("delete_sql_port", $delete_sql_port, 25),	1188	CGI::textfield("delete_sql_port", $delete_sql_port, 25),
731	CGI::br(),	1189	CGI::br(),
732	CGI::small("Leave blank to use the default port."),	1190	CGI::small("Leave blank to use the default port."),
733	),	1191	),
734	);	1192	);
735	print CGI::Tr(	1193
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(	1194	print CGI::Tr(
744	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),	1195	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
745	CGI::td(	1196	CGI::td(
746	CGI::textfield("delete_sql_database", $delete_sql_database, 25),	1197	CGI::textfield("delete_sql_database", $delete_sql_database, 25),
747	CGI::br(),	1198	CGI::br(),
…		…
899	CGI::p("An error occured while deleting the course $delete_courseID:"),	1350	CGI::p("An error occured while deleting the course $delete_courseID:"),
900	CGI::tt(CGI::escapeHTML($error)),	1351	CGI::tt(CGI::escapeHTML($error)),
901	);	1352	);
902	} else {	1353	} else {
903	print CGI::div({class=>"ResultsWithoutError"},	1354	print CGI::div({class=>"ResultsWithoutError"},
904	CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),	1355	CGI::p("Successfully deleted the course $delete_courseID."),
905	);	1356	);
906	writeLog($ce, "hosted_courses", join("\t",	1357	writeLog($ce, "hosted_courses", join("\t",
907	"\tDeleted",	1358	"\tDeleted",
908	"",	1359	"",
909	"",	1360	"",
…		…
931		1382
932	my @tables = keys %{$ce->{dbLayout}};	1383	my @tables = keys %{$ce->{dbLayout}};
933		1384
934	my $export_courseID = $r->param("export_courseID") \|\| "";	1385	my $export_courseID = $r->param("export_courseID") \|\| "";
935	my @export_tables = $r->param("export_tables");	1386	my @export_tables = $r->param("export_tables");
936		1387
937	@export_tables = @tables unless @export_tables;	1388	@export_tables = @tables unless @export_tables;
938		1389
939	my @courseIDs = listCourses($ce);	1390	my @courseIDs = listCourses($ce);
940	@courseIDs = sort @courseIDs;	1391	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
941		1392
942	my %courseLabels; # records... heh.	1393	my %courseLabels; # records... heh.
943	foreach my $courseID (@courseIDs) {	1394	foreach my $courseID (@courseIDs) {
944	my $tempCE = WeBWorK::CourseEnvironment->new(	1395	my $tempCE = WeBWorK::CourseEnvironment->new(
945	$ce->{webworkDirs}->{root},	1396	$ce->{webworkDirs}->{root},
…		…
950	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1401	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
951	}	1402	}
952		1403
953	print CGI::h2("Export Database");	1404	print CGI::h2("Export Database");
954		1405
955	print CGI::start_form("POST", $r->uri);	1406	print CGI::start_form("GET", $r->uri);
956	print $self->hidden_authen_fields;	1407	print $self->hidden_authen_fields;
957	print $self->hidden_fields("subDisplay");	1408	print $self->hidden_fields("subDisplay");
958		1409
959	print CGI::p("Select a course to export the course's database.");	1410	print CGI::p("Select a course to export the course's database. Please note
		1411	that exporting can take a very long time for a large course. If you have
		1412	shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
		1413	utility instead.");
960		1414
961	print CGI::table({class=>"FormLayout"},	1415	print CGI::table({class=>"FormLayout"},
962	CGI::Tr(	1416	CGI::Tr(
963	CGI::th({class=>"LeftHeader"}, "Course Name:"),	1417	CGI::th({class=>"LeftHeader"}, "Course Name:"),
964	CGI::td(	1418	CGI::td(
965	CGI::scrolling_list(	1419	CGI::scrolling_list(
966	-name => "export_courseID",	1420	-name => "export_courseID",
967	-values => \@courseIDs,	1421	-values => \@courseIDs,
968	-default => $export_courseID,	1422	-default => $export_courseID,
969	-size => 10,	1423	-size => 10,
970	-multiple => 0,	1424	-multiple => 1,
971	-labels => \%courseLabels,	1425	-labels => \%courseLabels,
972	),	1426	),
973	),	1427	),
974	),	1428	),
975	CGI::Tr(	1429	CGI::Tr(
…		…
996	#my $ce = $r->ce;	1450	#my $ce = $r->ce;
997	#my $db = $r->db;	1451	#my $db = $r->db;
998	#my $authz = $r->authz;	1452	#my $authz = $r->authz;
999	#my $urlpath = $r->urlpath;	1453	#my $urlpath = $r->urlpath;
1000		1454
1001	my $export_courseID = $r->param("export_courseID") \|\| "";	1455	my @export_courseID = $r->param("export_courseID") \|\| ();
1002	my @export_tables = $r->param("export_tables");	1456	my @export_tables = $r->param("export_tables");
1003		1457
1004	my @errors;	1458	my @errors;
1005		1459
1006	if ($export_courseID eq "") {	1460	unless ( @export_courseID) {
1007	push @errors, "You must specify a course name.";	1461	push @errors, "You must specify at least one course name.";
1008	}	1462	}
1009		1463
1010	unless (@export_tables) {	1464	unless (@export_tables) {
1011	push @errors, "You must specify at least one table to export.";	1465	push @errors, "You must specify at least one table to export.";
1012	}	1466	}
…		…
1020	my $ce = $r->ce;	1474	my $ce = $r->ce;
1021	#my $db = $r->db;	1475	#my $db = $r->db;
1022	#my $authz = $r->authz;	1476	#my $authz = $r->authz;
1023	my $urlpath = $r->urlpath;	1477	my $urlpath = $r->urlpath;
1024		1478
1025	my $export_courseID = $r->param("export_courseID");	1479	my @export_courseID = $r->param("export_courseID");
1026	my @export_tables = $r->param("export_tables");	1480	my @export_tables = $r->param("export_tables");
1027		1481
		1482	foreach my $export_courseID (@export_courseID) {
		1483
1028	my $ce2 = WeBWorK::CourseEnvironment->new(	1484	my $ce2 = WeBWorK::CourseEnvironment->new(
1029	$ce->{webworkDirs}->{root},	1485	$ce->{webworkDirs}->{root},
1030	$ce->{webworkURLs}->{root},	1486	$ce->{webworkURLs}->{root},
1031	$ce->{pg}->{directories}->{root},	1487	$ce->{pg}->{directories}->{root},
1032	$export_courseID,	1488	$export_courseID,
1033	);	1489	);
1034		1490
1035	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1491	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1036		1492
1037	my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});	1493	#my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1038	my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;	1494	#my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
		1495	# export to the admin/templates directory
		1496	my $exportFileName = "$export_courseID.exported.xml";
		1497	my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
		1498	# get a unique name
		1499	my $number =1;
		1500	while (-e "$exportFilePath.$number.gz") {
		1501	$number++;
		1502	last if $number>9;
		1503	}
		1504	if ($number<=9 ) {
		1505	$exportFilePath = "$exportFilePath.$number";
		1506	$exportFileName = "$exportFileName.$number";
		1507	} else {
		1508	$self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
		1509	remove some of these files."));
		1510	$exportFilePath = "$exportFilePath.999";
		1511	$exportFileName = "$exportFileName.999";
		1512	}
1039		1513
		1514	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
		1515
1040	my @errors;	1516	my @errors;
1041
1042	eval {	1517	eval {
1043	@errors = dbExport(	1518	@errors = dbExport(
1044	db => $db2,	1519	db => $db2,
1045	xml => $fh,	1520	#xml => $fh,
		1521	xml => $outputFileHandle,
1046	tables => \@export_tables,	1522	tables => \@export_tables,
1047	);	1523	);
1048	};	1524	};
		1525
		1526	$outputFileHandle->close();
1049		1527
		1528	my $gzipMessage = system( 'gzip', $exportFilePath);
		1529	if ( !$gzipMessage ) {
		1530	$self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
		1531	You may download it with the file manager."));
		1532	} else {
		1533	$self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
		1534	}
		1535	unlink $exportFilePath;
		1536	} # end export of one course
1050	push @errors, "Fatal exception: $@" if $@;	1537	#push @errors, "Fatal exception: $@" if $@;
1051		1538	#
1052	if (@errors) {	1539	#if (@errors) {
1053	print CGI::div({class=>"ResultsWithError"},	1540	# print CGI::div({class=>"ResultsWithError"},
1054	CGI::p("An error occured while exporting the database of course $export_courseID:"),	1541	# CGI::p("An error occured while exporting the database of course $export_courseID:"),
1055	CGI::ul(CGI::li(\@errors)),	1542	# CGI::ul(CGI::li(\@errors)),
1056	);	1543	# );
1057	} else {	1544	#} else {
1058	print CGI::div({class=>"ResultsWithoutError"},	1545	# print CGI::div({class=>"ResultsWithoutError"},
1059	CGI::p("Export succeeded."),	1546	# CGI::p("Export succeeded."),
1060	);	1547	# );
1061		1548	#
1062	print CGI::div({style=>"text-align: center"},	1549	# 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"),	1550	# CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1064	);	1551	# );
1065	}	1552	#}
1066	}	1553	}
1067		1554
1068	################################################################################	1555	################################################################################
1069		1556
1070	sub import_database_form {	1557	sub import_database_form {
…		…
1083	my $import_conflict = $r->param("import_conflict") \|\| "skip";	1570	my $import_conflict = $r->param("import_conflict") \|\| "skip";
1084		1571
1085	@import_tables = @tables unless @import_tables;	1572	@import_tables = @tables unless @import_tables;
1086		1573
1087	my @courseIDs = listCourses($ce);	1574	my @courseIDs = listCourses($ce);
1088	@courseIDs = sort @courseIDs;	1575	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1089		1576
1090		1577
1091	my %courseLabels; # records... heh.	1578	my %courseLabels; # records... heh.
1092	foreach my $courseID (@courseIDs) {	1579	foreach my $courseID (@courseIDs) {
1093	my $tempCE = WeBWorK::CourseEnvironment->new(	1580	my $tempCE = WeBWorK::CourseEnvironment->new(
…		…
1097	$courseID,	1584	$courseID,
1098	);	1585	);
1099	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1586	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1100	}	1587	}
1101		1588
		1589	# find databases:
		1590	my $templatesDir = $ce->{courseDirs}->{templates};
		1591	my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
		1592	my $exempt_dirs = join("\|", keys %probLibs);
		1593
		1594	my @databaseFiles = listFilesRecursive(
		1595	$templatesDir,
		1596	qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
		1597	qr/^(?:$exempt_dirs\|CVS)$/, # prune these directories
		1598	0, # match against file name only
		1599	1, # prune against path relative to $templatesDir
		1600	);
		1601
		1602	my %databaseLabels = map { ($_ => $_) } @databaseFiles;
		1603
		1604	#######
		1605
1102	print CGI::h2("Import Database");	1606	print CGI::h2("Import Database");
1103		1607
1104	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);	1608	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1105	print $self->hidden_authen_fields;	1609	print $self->hidden_authen_fields;
1106	print $self->hidden_fields("subDisplay");	1610	print $self->hidden_fields("subDisplay");
1107		1611
1108	print CGI::table({class=>"FormLayout"},	1612	print CGI::table({class=>"FormLayout"},
1109	CGI::Tr(	1613	CGI::Tr(
1110	CGI::th({class=>"LeftHeader"}, "Database XML File:"),	1614	CGI::th({class=>"LeftHeader"}, "Database XML File:"),
		1615	# CGI::td(
		1616	# CGI::filefield(
		1617	# -name => "import_file",
		1618	# -size => 50,
		1619	# ),
		1620	# ),
1111	CGI::td(	1621	CGI::td(
1112	CGI::filefield(	1622	CGI::scrolling_list(
1113	-name => "import_file",	1623	-name => "import_file",
		1624	-values => \@databaseFiles,
		1625	-default => undef,
1114	-size => 50,	1626	-size => 10,
		1627	-multiple => 0,
		1628	-labels => \%databaseLabels,
1115	),	1629	),
		1630
1116	),	1631	)
1117	),	1632	),
1118	CGI::Tr(	1633	CGI::Tr(
1119	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),	1634	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1120	CGI::td(	1635	CGI::td(
1121	CGI::checkbox_group(	1636	CGI::checkbox_group(
…		…
1175	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked	1690	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1176		1691
1177	my @errors;	1692	my @errors;
1178		1693
1179	if ($import_file eq "") {	1694	if ($import_file eq "") {
1180	push @errors, "You must specify a database file to upload.";	1695	push @errors, "You must specify a database file to import.";
1181	}	1696	}
1182		1697
1183	if ($import_courseID eq "") {	1698	if ($import_courseID eq "") {
1184	push @errors, "You must specify a course name.";	1699	push @errors, "You must specify a course name.";
1185	}	1700	}
…		…
1211	$import_courseID,	1726	$import_courseID,
1212	);	1727	);
1213		1728
1214	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1729	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1215		1730
		1731	# locate file
		1732	my $templateDir = $ce->{courseDirs}->{templates};
		1733	my $filePath = "$templateDir/$import_file";
		1734
		1735	my $gunzipMessage = system( 'gunzip', $filePath);
		1736	#FIXME
		1737	#warn "gunzip ", $gunzipMessage;
		1738	$filePath =~ s/\.gz$//;
		1739	#warn "new file path is $filePath";
		1740	my $fileHandle = new IO::File("<$filePath");
1216	# retrieve upload from upload cache	1741	# retrieve upload from upload cache
1217	my ($id, $hash) = split /\s+/, $import_file;	1742	# my ($id, $hash) = split /\s+/, $import_file;
1218	my $upload = WeBWorK::Upload->retrieve($id, $hash,	1743	# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1219	dir => $ce->{webworkDirs}->{uploadCache}	1744	# dir => $ce->{webworkDirs}->{uploadCache}
1220	);	1745	# );
1221		1746
1222	my @errors;	1747	my @errors;
1223		1748
1224	eval {	1749	eval {
1225	@errors = dbImport(	1750	@errors = dbImport(
1226	db => $db2,	1751	db => $db2,
1227	xml => $upload->fileHandle,	1752	# xml => $upload->fileHandle,
		1753	xml => $fileHandle,
1228	tables => \@import_tables,	1754	tables => \@import_tables,
1229	conflict => $import_conflict,	1755	conflict => $import_conflict,
1230	);	1756	);
1231	};	1757	};
1232		1758
1233	$upload->dispose;
1234
1235	push @errors, "Fatal exception: $@" if $@;	1759	push @errors, "Fatal exception: $@" if $@;
		1760	push @errors, $gunzipMessage if $gunzipMessage;
1236		1761
1237	if (@errors) {	1762	if (@errors) {
1238	print CGI::div({class=>"ResultsWithError"},	1763	print CGI::div({class=>"ResultsWithError"},
1239	CGI::p("An error occured while importing the database of course $import_courseID:"),	1764	CGI::p("An error occured while importing the database of course $import_courseID:"),
1240	CGI::ul(CGI::li(\@errors)),	1765	CGI::ul(CGI::li(\@errors)),
…		…
1243	print CGI::div({class=>"ResultsWithoutError"},	1768	print CGI::div({class=>"ResultsWithoutError"},
1244	CGI::p("Import succeeded."),	1769	CGI::p("Import succeeded."),
1245	);	1770	);
1246	}	1771	}
1247	}	1772	}
		1773	##########################################################################
		1774	sub archive_course_form {
		1775	my ($self) = @_;
		1776	my $r = $self->r;
		1777	my $ce = $r->ce;
		1778	#my $db = $r->db;
		1779	#my $authz = $r->authz;
		1780	#my $urlpath = $r->urlpath;
		1781
		1782	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1783	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1784	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1785	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1786	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1787	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1788
		1789	my @courseIDs = listCourses($ce);
		1790	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
		1791
		1792	my %courseLabels; # records... heh.
		1793	foreach my $courseID (@courseIDs) {
		1794	my $tempCE = WeBWorK::CourseEnvironment->new(
		1795	$ce->{webworkDirs}->{root},
		1796	$ce->{webworkURLs}->{root},
		1797	$ce->{pg}->{directories}->{root},
		1798	$courseID,
		1799	);
		1800	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		1801	}
		1802
		1803	print CGI::h2("archive Course");
		1804
		1805	print CGI::start_form("POST", $r->uri);
		1806	print $self->hidden_authen_fields;
		1807	print $self->hidden_fields("subDisplay");
		1808
		1809	print CGI::p("Select a course to archive.");
		1810
		1811	print CGI::table({class=>"FormLayout"},
		1812	CGI::Tr(
		1813	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		1814	CGI::td(
		1815	CGI::scrolling_list(
		1816	-name => "archive_courseID",
		1817	-values => \@courseIDs,
		1818	-default => $archive_courseID,
		1819	-size => 10,
		1820	-multiple => 0,
		1821	-labels => \%courseLabels,
		1822	),
		1823	),
		1824	),
		1825	);
		1826
		1827	print CGI::p(
		1828	"Currently the archive facility is only available for mysql databases.
		1829	It depends on the mysqldump application."
		1830	);
		1831	# print CGI::p(
		1832	# "If the course's database layout (indicated in parentheses above) is "
		1833	# . CGI::b("sql") . ", supply the SQL connections information requested below."
		1834	# );
		1835
		1836	# print CGI::start_table({class=>"FormLayout"});
		1837	# print CGI::Tr(CGI::td({colspan=>2},
		1838	# "Enter the user ID and password for an SQL account with sufficient permissions to archive an existing database."
		1839	# )
		1840	# );
		1841	# print CGI::Tr(
		1842	# CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		1843	# CGI::td(CGI::textfield("archive_sql_username", $archive_sql_username, 25)),
		1844	# );
		1845	# print CGI::Tr(
		1846	# CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		1847	# CGI::td(CGI::password_field("archive_sql_password", $archive_sql_password, 25)),
		1848	# );
		1849	#
		1850	# #print CGI::Tr(CGI::td({colspan=>2},
		1851	# # "The optionial SQL settings you enter below must match the settings in the DBI source"
		1852	# # . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
		1853	# # . " with the course name you entered above."
		1854	# # )
		1855	# #);
		1856	# print CGI::Tr(
		1857	# CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
		1858	# CGI::td(
		1859	# CGI::textfield("archive_sql_host", $archive_sql_host, 25),
		1860	# CGI::br(),
		1861	# CGI::small("Leave blank to use the default host."),
		1862	# ),
		1863	# );
		1864	# print CGI::Tr(
		1865	# CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
		1866	# CGI::td(
		1867	# CGI::textfield("archive_sql_port", $archive_sql_port, 25),
		1868	# CGI::br(),
		1869	# CGI::small("Leave blank to use the default port."),
		1870	# ),
		1871	# );
		1872	#
		1873	# print CGI::Tr(
		1874	# CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
		1875	# CGI::td(
		1876	# CGI::textfield("archive_sql_database", $archive_sql_database, 25),
		1877	# CGI::br(),
		1878	# CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
		1879	# ),
		1880	# );
		1881	# print CGI::end_table();
		1882
		1883	print CGI::p({style=>"text-align: center"}, CGI::submit("archive_course", "archive Course"));
		1884
		1885	print CGI::end_form();
		1886	}
1248		1887
		1888	sub archive_course_validate {
		1889	my ($self) = @_;
		1890	my $r = $self->r;
		1891	my $ce = $r->ce;
		1892	#my $db = $r->db;
		1893	#my $authz = $r->authz;
		1894	my $urlpath = $r->urlpath;
		1895
		1896	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1897	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1898	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1899	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1900	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1901	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1902
		1903	my @errors;
		1904
		1905	if ($archive_courseID eq "") {
		1906	push @errors, "You must specify a course name.";
		1907	} elsif ($archive_courseID eq $urlpath->arg("courseID")) {
		1908	push @errors, "You cannot archive the course you are currently using.";
		1909	}
		1910
		1911	my $ce2 = WeBWorK::CourseEnvironment->new(
		1912	$ce->{webworkDirs}->{root},
		1913	$ce->{webworkURLs}->{root},
		1914	$ce->{pg}->{directories}->{root},
		1915	$archive_courseID,
		1916	);
		1917
		1918	if ($ce2->{dbLayoutName} eq "sql") {
		1919	push @errors, "You must specify the SQL admin username." if $archive_sql_username eq "";
		1920	#push @errors, "You must specify the SQL admin password." if $archive_sql_password eq "";
		1921	#push @errors, "You must specify the SQL database name." if $archive_sql_database eq "";
		1922	}
		1923
		1924	return @errors;
		1925	}
		1926
		1927	sub archive_course_confirm {
		1928	my ($self) = @_;
		1929	my $r = $self->r;
		1930	my $ce = $r->ce;
		1931	#my $db = $r->db;
		1932	#my $authz = $r->authz;
		1933	#my $urlpath = $r->urlpath;
		1934
		1935	print CGI::h2("archive Course");
		1936
		1937	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1938	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1939	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1940	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		1941
		1942	my $ce2 = WeBWorK::CourseEnvironment->new(
		1943	$ce->{webworkDirs}->{root},
		1944	$ce->{webworkURLs}->{root},
		1945	$ce->{pg}->{directories}->{root},
		1946	$archive_courseID,
		1947	);
		1948
		1949	if ($ce2->{dbLayoutName} eq "sql") {
		1950	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
		1951	. "? ");
		1952
		1953	print CGI::table({class=>"FormLayout"},
		1954	CGI::Tr(
		1955	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
		1956	CGI::td($archive_sql_host \|\| "system default"),
		1957	),
		1958	CGI::Tr(
		1959	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
		1960	CGI::td($archive_sql_port \|\| "system default"),
		1961	),
		1962	CGI::Tr(
		1963	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
		1964	CGI::td($archive_sql_database \|\| "webwork_$archive_courseID"),
		1965	),
		1966	);
		1967	} else {
		1968	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
		1969	. "? All course files and data will be destroyed. There is no undo available.");
		1970	}
		1971
		1972	print CGI::start_form("POST", $r->uri);
		1973	print $self->hidden_authen_fields;
		1974	print $self->hidden_fields("subDisplay");
		1975	print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database/);
		1976
		1977	print CGI::p({style=>"text-align: center"},
		1978	CGI::submit("decline_archive_course", "Don't archive"),
		1979	" ",
		1980	CGI::submit("confirm_archive_course", "archive"),
		1981	);
		1982
		1983	print CGI::end_form();
		1984	}
		1985
		1986	sub do_archive_course {
		1987	my ($self) = @_;
		1988	my $r = $self->r;
		1989	my $ce = $r->ce;
		1990	#my $db = $r->db;
		1991	#my $authz = $r->authz;
		1992	#my $urlpath = $r->urlpath;
		1993
		1994	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1995	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1996	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1997	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1998	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		1999	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		2000
		2001	my $ce2 = WeBWorK::CourseEnvironment->new(
		2002	$ce->{webworkDirs}->{root},
		2003	$ce->{webworkURLs}->{root},
		2004	$ce->{pg}->{directories}->{root},
		2005	$archive_courseID,
		2006	);
		2007
		2008	my %dbOptions;
		2009	if ($ce2->{dbLayoutName} eq "sql") {
		2010	$dbOptions{host} = $archive_sql_host if $archive_sql_host ne "";
		2011	$dbOptions{port} = $archive_sql_port if $archive_sql_port ne "";
		2012	$dbOptions{username} = $archive_sql_username;
		2013	$dbOptions{password} = $archive_sql_password;
		2014	$dbOptions{database} = $archive_sql_database \|\| "webwork_$archive_courseID";
		2015	}
		2016
		2017	eval {
		2018	archiveCourse(
		2019	courseID => $archive_courseID,
		2020	ce => $ce2,
		2021	dbOptions => \%dbOptions,
		2022	);
		2023	};
		2024
		2025	if ($@) {
		2026	my $error = $@;
		2027	print CGI::div({class=>"ResultsWithError"},
		2028	CGI::p("An error occured while archiving the course $archive_courseID:"),
		2029	CGI::tt(CGI::escapeHTML($error)),
		2030	);
		2031	} else {
		2032	print CGI::div({class=>"ResultsWithoutError"},
		2033	CGI::p("Successfully archived the course $archive_courseID"),
		2034	);
		2035	writeLog($ce, "hosted_courses", join("\t",
		2036	"\tarchived",
		2037	"",
		2038	"",
		2039	$archive_courseID,
		2040	));
		2041	print CGI::start_form("POST", $r->uri);
		2042	print $self->hidden_authen_fields;
		2043	print $self->hidden_fields("subDisplay");
		2044
		2045	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),);
		2046
		2047	print CGI::end_form();
		2048	}
		2049	}
		2050
		2051	################################################################################
1249	1;	2052	1;

 Legend:



Removed from v.2299
 


changed lines


 
Added in v.3973
 Legend:



Removed from v.2299
 


changed lines


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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9