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

Revision 2189		Revision 3528
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-2003 The WeBWorK Project, http://openwebwork.sf.net/
4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.12 2004/05/22 01:08:09 sh002i Exp $	4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.39 2005/07/31 17:27:21 gage Exp $
5	#	5	#
6	# This program is free software; you can redistribute it and/or modify it under	6	# This program is free software; you can redistribute it and/or modify it under
7	# the terms of either: (a) the GNU General Public License as published by the	7	# the terms of either: (a) the GNU General Public License as published by the
8	# Free Software Foundation; either version 2, or (at your option) any later	8	# Free Software Foundation; either version 2, or (at your option) any later
9	# version, or (b) the "Artistic License" which comes with this package.	9	# version, or (b) the "Artistic License" which comes with this package.
…		…
27	use warnings;	27	use warnings;
28	use CGI::Pretty qw();	28	use CGI::Pretty 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 WeBWorK::Utils qw(cryptPassword);	32	use IO::File;
		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
…		…
194	my $ce = $r->ce;	338	my $ce = $r->ce;
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_templates_course = $r->param("add_templates_course") \|\| "";
211		366
212	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	};
213		385
214	my $ce2 = WeBWorK::CourseEnvironment->new(	386	my $ce2 = WeBWorK::CourseEnvironment->new(
215	$ce->{webworkDirs}->{root},	387	$ce->{webworkDirs}->{root},
216	$ce->{webworkURLs}->{root},	388	$ce->{webworkURLs}->{root},
217	$ce->{pg}->{directories}->{root},	389	$ce->{pg}->{directories}->{root},
…		…
235	}	407	}
236	$source;	408	$source;
237	};	409	};
238		410
239	my @existingCourses = listCourses($ce);	411	my @existingCourses = listCourses($ce);
		412	@existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
240		413
241	print CGI::h2("Add Course");	414	print CGI::h2("Add Course");
242		415
243	print CGI::start_form("POST", $r->uri);	416	print CGI::start_form("POST", $r->uri);
244	print $self->hidden_authen_fields;	417	print $self->hidden_authen_fields;
245	print $self->hidden_fields("subDisplay");	418	print $self->hidden_fields("subDisplay");
246		419
247	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.");
248		421
249	print CGI::table({class=>"FormLayout"},	422	print CGI::table({class=>"FormLayout"},
250	CGI::Tr(	423	CGI::Tr(
251	CGI::th({class=>"LeftHeader"}, "Course Name:"),	424	CGI::th({class=>"LeftHeader"}, "Course ID:"),
252	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),	425	CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
253	),	426	),
		427	CGI::Tr(
		428	CGI::th({class=>"LeftHeader"}, "Course Title:"),
		429	CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)),
		430	),
		431	CGI::Tr(
		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(
		451	CGI::th({class=>"LeftHeader"}, "Password:"),
		452	CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
		453	),
		454	CGI::Tr(
		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	),
		475
		476	),
254	);	477	));
255		478
256	print CGI::p("Select a database layout below. Some database layouts require additional information.");	479	print CGI::p("To copy problem templates from an existing course, select the course below.");
257		480
258	#print CGI::start_Tr();	481	print CGI::table({class=>"FormLayout"},
259	#print CGI::th({class=>"LeftHeader"}, "Database Layout:");	482	CGI::Tr(
260	#print CGI::start_td();	483	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
		484	CGI::td(
		485	CGI::popup_menu(
		486	-name => "add_templates_course",
		487	-values => [ "", @existingCourses ],
		488	-default => $add_templates_course,
		489	#-size => 10,
		490	#-multiple => 0,
		491	#-labels => \%courseLabels,
		492	),
		493
		494	),
		495	),
		496	);
		497
		498	print CGI::p("Select a database layout below.");
261		499
262	foreach my $dbLayout (@dbLayouts) {	500	foreach my $dbLayout (@dbLayouts) {
263	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;
264		506
265	# 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
266	print CGI::Tr(	508	print CGI::Tr(
267	CGI::td({style=>"text-align: right"},	509	CGI::td({style=>"text-align: right"},
268	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'	510	'<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
269	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',	511	. ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
270	),	512	),
271	CGI::td($dbLayout),	513	CGI::td($dbLayoutLabel),
272	);	514	);
273		515
274	print CGI::start_Tr();	516	print CGI::start_Tr();
275	print CGI::td(); # for indentation :(	517	print CGI::td(); # for indentation :(
276	print CGI::start_td();	518	print CGI::start_td();
277		519
		520
278	if ($dbLayout eq "sql") {	521	if ($dbLayout eq "sql") {
279	print CGI::p(	522
280	"The SQL settings you enter below must match the settings in the DBI source",	523	print CGI::p({style=>'font-style:italic'},"The following information is only required for the deprecated sql database format:");
281	" specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"),	524	print CGI::start_table({class=>"FormLayout"});
282	" with the course name you entered above."	525	print CGI::Tr(CGI::td({colspan=>2},
		526	"Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
		527	)
283	);	528	);
284	print CGI::start_table({class=>"FormLayout"});	529	print CGI::Tr(
		530	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
		531	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
		532	);
		533	print CGI::Tr(
		534	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
		535	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
		536	);
		537
		538	print CGI::Tr(CGI::td({colspan=>2},
		539	"The optionial SQL settings you enter below must match the settings in the DBI source"
		540	. " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
		541	. " with the course name you entered above."
		542	)
		543	);
285	print CGI::Tr(	544	print CGI::Tr(
286	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),	545	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
287	CGI::td(	546	CGI::td(
288	CGI::textfield("add_sql_host", $add_sql_host, 25),	547	CGI::textfield("add_sql_host", $add_sql_host, 25),
289	CGI::br(),	548	CGI::br(),
…		…
296	CGI::textfield("add_sql_port", $add_sql_port, 25),	555	CGI::textfield("add_sql_port", $add_sql_port, 25),
297	CGI::br(),	556	CGI::br(),
298	CGI::small("Leave blank to use the default port."),	557	CGI::small("Leave blank to use the default port."),
299	),	558	),
300	);	559	);
301	print CGI::Tr(	560
302	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
303	CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
304	);
305	print CGI::Tr(
306	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
307	CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
308	);
309	print CGI::Tr(	561	print CGI::Tr(
310	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),	562	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
311	CGI::td(	563	CGI::td(
312	CGI::textfield("add_sql_database", $add_sql_database, 25),	564	CGI::textfield("add_sql_database", $add_sql_database, 25),
313	CGI::br(),	565	CGI::br(),
…		…
322	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."),
323	),	575	),
324	);	576	);
325	print CGI::end_table();	577	print CGI::end_table();
326	} 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:");
327	print CGI::start_table({class=>"FormLayout"});	580	print CGI::start_table({class=>"FormLayout"});
328	print CGI::Tr(	581	print CGI::Tr(
329	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),	582	CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
330	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)),
331	);	584	);
…		…
335	print CGI::end_td();	588	print CGI::end_td();
336	print CGI::end_Tr();	589	print CGI::end_Tr();
337	print CGI::end_table();	590	print CGI::end_table();
338	}	591	}
339		592
340
341	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.");
342
343	print CGI::table({class=>"FormLayout"},
344	CGI::Tr(
345	CGI::th({class=>"LeftHeader"}, "Professor User ID:"),
346	CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID \|\| "professor", 25)),
347	),
348	CGI::Tr(
349	CGI::th({class=>"LeftHeader"}, "Professor Password:"),
350	CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
351	),
352	);
353
354	print CGI::p("Select an existing course from which to copy templates:");
355
356	print CGI::table({class=>"FormLayout"},
357	CGI::Tr(
358	CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
359	CGI::td(
360	CGI::popup_menu(
361	-name => "add_templates_course",
362	-values => [ "", @existingCourses ],
363	-default => $add_templates_course,
364	#-size => 10,
365	#-multiple => 0,
366	#-labels => \%courseLabels,
367	),
368
369	),
370	),
371	);
372
373	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"));
374		594
375	print CGI::end_form();	595	print CGI::end_form();
376	}	596	}
377		597
…		…
381	my $ce = $r->ce;	601	my $ce = $r->ce;
382	#my $db = $r->db;	602	#my $db = $r->db;
383	#my $authz = $r->authz;	603	#my $authz = $r->authz;
384	#my $urlpath = $r->urlpath;	604	#my $urlpath = $r->urlpath;
385		605
386	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
387	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	621	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
388	my $add_sql_host = $r->param("add_sql_host") \|\| "";	622	my $add_sql_host = $r->param("add_sql_host") \|\| "";
389	my $add_sql_port = $r->param("add_sql_port") \|\| "";	623	my $add_sql_port = $r->param("add_sql_port") \|\| "";
390	my $add_sql_username = $r->param("add_sql_username") \|\| "";	624	my $add_sql_username = $r->param("add_sql_username") \|\| "";
391	my $add_sql_password = $r->param("add_sql_password") \|\| "";	625	my $add_sql_password = $r->param("add_sql_password") \|\| "";
392	my $add_sql_database = $r->param("add_sql_database") \|\| "";	626	my $add_sql_database = $r->param("add_sql_database") \|\| "";
393	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	627	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
394	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	628	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
395	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";
396	my $add_initial_password = $r->param("add_initial_password") \|\| "";
397	my $add_templates_course = $r->param("add_templates_course") \|\| "";
398		629
399	my @errors;	630	my @errors;
400		631
401	if ($add_courseID eq "") {	632	if ($add_courseID eq "") {
402	push @errors, "You must specify a course name.";	633	push @errors, "You must specify a course ID.";
		634	}
		635	unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
		636	push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
		637	}
		638	if (grep { $add_courseID eq $_ } listCourses($ce)) {
		639	push @errors, "A course with ID $add_courseID already exists.";
		640	}
		641	if ($add_courseTitle eq "") {
		642	push @errors, "You must specify a course title.";
		643	}
		644	if ($add_courseInstitution eq "") {
		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	}
403	}	667	}
404		668
405	if ($add_dbLayout eq "") {	669	if ($add_dbLayout eq "") {
406	push @errors, "You must select a database layout.";	670	push @errors, "You must select a database layout.";
407	} else {	671	} else {
408	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {	672	if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
409	if ($add_dbLayout eq "sql") {	673	if ($add_dbLayout eq "sql") {
410	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 "";
411	#push @errors, "You must specify the SQL admin password." if $add_sql_password eq "";
412	#push @errors, "You must specify the SQL database name." if $add_sql_database eq "";
413	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 "";
414	} elsif ($add_dbLayout eq "gdbm") {	676	} elsif ($add_dbLayout eq "gdbm") {
415	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 "";
416	}	678	}
417	} else {	679	} else {
418	push @errors, "The database layout $add_dbLayout doesn't exist.";	680	push @errors, "The database layout $add_dbLayout doesn't exist.";
419	}	681	}
420	}	682	}
421		683
422	if ($add_initial_userID ne "") {
423	push @errors, "You must specify a professor password." if $add_initial_password eq "";
424	}
425
426	return @errors;	684	return @errors;
427	}	685	}
428		686
429	sub do_add_course {	687	sub do_add_course {
430	my ($self) = @_;	688	my ($self) = @_;
…		…
432	my $ce = $r->ce;	690	my $ce = $r->ce;
433	my $db = $r->db;	691	my $db = $r->db;
434	#my $authz = $r->authz;	692	#my $authz = $r->authz;
435	my $urlpath = $r->urlpath;	693	my $urlpath = $r->urlpath;
436		694
437	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
438	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";	710	my $add_dbLayout = $r->param("add_dbLayout") \|\| "";
439	my $add_sql_host = $r->param("add_sql_host") \|\| "";	711	my $add_sql_host = $r->param("add_sql_host") \|\| "";
440	my $add_sql_port = $r->param("add_sql_port") \|\| "";	712	my $add_sql_port = $r->param("add_sql_port") \|\| "";
441	my $add_sql_username = $r->param("add_sql_username") \|\| "";	713	my $add_sql_username = $r->param("add_sql_username") \|\| "";
442	my $add_sql_password = $r->param("add_sql_password") \|\| "";	714	my $add_sql_password = $r->param("add_sql_password") \|\| "";
443	my $add_sql_database = $r->param("add_sql_database") \|\| "";	715	my $add_sql_database = $r->param("add_sql_database") \|\| "";
444	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";	716	my $add_sql_wwhost = $r->param("add_sql_wwhost") \|\| "";
445	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";	717	my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") \|\| "";
446	my $add_initial_userID = $r->param("add_initial_userID") \|\| "";	718
447	my $add_initial_password = $r->param("add_initial_password") \|\| "";
448	my $add_templates_course = $r->param("add_templates_course") \|\| "";
449
450	my $ce2 = WeBWorK::CourseEnvironment->new(	719	my $ce2 = WeBWorK::CourseEnvironment->new(
451	$ce->{webworkDirs}->{root},	720	$ce->{webworkDirs}->{root},
452	$ce->{webworkURLs}->{root},	721	$ce->{webworkURLs}->{root},
453	$ce->{pg}->{directories}->{root},	722	$ce->{pg}->{directories}->{root},
454	$add_courseID,	723	$add_courseID,
455	);	724	);
456		725
457	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
458	if ($add_dbLayout eq "gdbm") {	735	if ($add_dbLayout eq "gdbm") {
459	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";	736	$courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
460	}	737	}
461		738
462	my %dbOptions;	739	my %dbOptions;
…		…
468	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";	745	$dbOptions{database} = $add_sql_database \|\| "webwork_$add_courseID";
469	$dbOptions{wwhost} = $add_sql_wwhost;	746	$dbOptions{wwhost} = $add_sql_wwhost;
470	}	747	}
471		748
472	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
473	if ($add_initial_userID ne "") {	766	if ($add_initial_userID ne "") {
474	my $User = $db->newUser(	767	my $User = $db->newUser(
475	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,
476	status => "C",	773	status => "C",
477	);	774	);
478	my $Password = $db->newPassword(	775	my $Password = $db->newPassword(
479	user_id => $add_initial_userID,	776	user_id => $add_initial_userID,
480	password => cryptPassword($add_initial_password),	777	password => cryptPassword($add_initial_password),
481	);	778	);
482	my $PermissionLevel = $db->newPermissionLevel(	779	my $PermissionLevel = $db->newPermissionLevel(
483	user_id => $add_initial_userID,	780	user_id => $add_initial_userID,
484	permission => "10",	781	permission => "10",
485	);	782	);
486	push @users, [ $User, $Password, $PermissionLevel ];	783	push @users, [ $User, $Password, $PermissionLevel ];
487	}	784	}
		785
		786	push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
488		787
489	my %optional_arguments;	788	my %optional_arguments;
490	if ($add_templates_course ne "") {	789	if ($add_templates_course ne "") {
491	$optional_arguments{templatesFrom} = $add_templates_course;	790	$optional_arguments{templatesFrom} = $add_templates_course;
492	}	791	}
…		…
499	dbOptions => \%dbOptions,	798	dbOptions => \%dbOptions,
500	users => \@users,	799	users => \@users,
501	%optional_arguments,	800	%optional_arguments,
502	);	801	);
503	};	802	};
504
505	if ($@) {	803	if ($@) {
506	my $error = $@;	804	my $error = $@;
507	print CGI::div({class=>"ResultsWithError"},	805	print CGI::div({class=>"ResultsWithError"},
508	CGI::p("An error occured while creating the course $add_courseID:"),	806	CGI::p("An error occured while creating the course $add_courseID:"),
509	CGI::tt(CGI::escapeHTML($error)),	807	CGI::tt(CGI::escapeHTML($error)),
510	);	808	);
		809	# get rid of any partially built courses
		810	# FIXME -- this is too fragile
		811	unless ($error =~ /course exists/) {
		812	eval {
		813	deleteCourse(
		814	courseID => $add_courseID,
		815	ce => $ce2,
		816	dbOptions => \%dbOptions,
		817	);
		818	}
		819	}
511	} else {	820	} else {
		821	#log the action
		822	writeLog($ce, "hosted_courses", join("\t",
		823	"\tAdded",
		824	$add_courseInstitution,
		825	$add_courseTitle,
		826	$add_courseID,
		827	$add_initial_firstName,
		828	$add_initial_lastName,
		829	$add_initial_email,
		830	));
		831	# add contact to admin course as student?
		832	# FIXME -- should we do this?
512	print CGI::div({class=>"ResultsWithoutError"},	833	print CGI::div({class=>"ResultsWithoutError"},
513	CGI::p("Successfully created the course $add_courseID"),	834	CGI::p("Successfully created the course $add_courseID"),
514	);	835	);
515	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",	836	my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
516	courseID => $add_courseID);	837	courseID => $add_courseID);
517	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);	838	my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
518	print CGI::div({style=>"text-align: center"},	839	print CGI::div({style=>"text-align: center"},
519	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),	840	CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
		841	);
		842	}
		843
		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"),
520	);	1093	);
521	}	1094	}
522	}	1095	}
523		1096
524	################################################################################	1097	################################################################################
…		…
537	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";	1110	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
538	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";	1111	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
539	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";	1112	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
540		1113
541	my @courseIDs = listCourses($ce);	1114	my @courseIDs = listCourses($ce);
542	@courseIDs = sort @courseIDs;	1115	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
543		1116
544	my %courseLabels; # records... heh.	1117	my %courseLabels; # records... heh.
545	foreach my $courseID (@courseIDs) {	1118	foreach my $courseID (@courseIDs) {
546	my $tempCE = WeBWorK::CourseEnvironment->new(	1119	my $tempCE = WeBWorK::CourseEnvironment->new(
547	$ce->{webworkDirs}->{root},	1120	$ce->{webworkDirs}->{root},
…		…
580	"If the course's database layout (indicated in parentheses above) is "	1153	"If the course's database layout (indicated in parentheses above) is "
581	. CGI::b("sql") . ", supply the SQL connections information requested below."	1154	. CGI::b("sql") . ", supply the SQL connections information requested below."
582	);	1155	);
583		1156
584	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	#);
585	print CGI::Tr(	1177	print CGI::Tr(
586	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),	1178	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
587	CGI::td(	1179	CGI::td(
588	CGI::textfield("delete_sql_host", $delete_sql_host, 25),	1180	CGI::textfield("delete_sql_host", $delete_sql_host, 25),
589	CGI::br(),	1181	CGI::br(),
…		…
596	CGI::textfield("delete_sql_port", $delete_sql_port, 25),	1188	CGI::textfield("delete_sql_port", $delete_sql_port, 25),
597	CGI::br(),	1189	CGI::br(),
598	CGI::small("Leave blank to use the default port."),	1190	CGI::small("Leave blank to use the default port."),
599	),	1191	),
600	);	1192	);
601	print CGI::Tr(	1193
602	CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
603	CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
604	);
605	print CGI::Tr(
606	CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
607	CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
608	);
609	print CGI::Tr(	1194	print CGI::Tr(
610	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),	1195	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
611	CGI::td(	1196	CGI::td(
612	CGI::textfield("delete_sql_database", $delete_sql_database, 25),	1197	CGI::textfield("delete_sql_database", $delete_sql_database, 25),
613	CGI::br(),	1198	CGI::br(),
…		…
765	CGI::p("An error occured while deleting the course $delete_courseID:"),	1350	CGI::p("An error occured while deleting the course $delete_courseID:"),
766	CGI::tt(CGI::escapeHTML($error)),	1351	CGI::tt(CGI::escapeHTML($error)),
767	);	1352	);
768	} else {	1353	} else {
769	print CGI::div({class=>"ResultsWithoutError"},	1354	print CGI::div({class=>"ResultsWithoutError"},
770	CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),	1355	CGI::p("Successfully deleted the course $delete_courseID."),
771	);	1356	);
772		1357	writeLog($ce, "hosted_courses", join("\t",
		1358	"\tDeleted",
		1359	"",
		1360	"",
		1361	$delete_courseID,
		1362	));
773	print CGI::start_form("POST", $r->uri);	1363	print CGI::start_form("POST", $r->uri);
774	print $self->hidden_authen_fields;	1364	print $self->hidden_authen_fields;
775	print $self->hidden_fields("subDisplay");	1365	print $self->hidden_fields("subDisplay");
776		1366
777	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);	1367	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
…		…
792		1382
793	my @tables = keys %{$ce->{dbLayout}};	1383	my @tables = keys %{$ce->{dbLayout}};
794		1384
795	my $export_courseID = $r->param("export_courseID") \|\| "";	1385	my $export_courseID = $r->param("export_courseID") \|\| "";
796	my @export_tables = $r->param("export_tables");	1386	my @export_tables = $r->param("export_tables");
797		1387
798	@export_tables = @tables unless @export_tables;	1388	@export_tables = @tables unless @export_tables;
799		1389
800	my @courseIDs = listCourses($ce);	1390	my @courseIDs = listCourses($ce);
801	@courseIDs = sort @courseIDs;	1391	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
802		1392
803	my %courseLabels; # records... heh.	1393	my %courseLabels; # records... heh.
804	foreach my $courseID (@courseIDs) {	1394	foreach my $courseID (@courseIDs) {
805	my $tempCE = WeBWorK::CourseEnvironment->new(	1395	my $tempCE = WeBWorK::CourseEnvironment->new(
806	$ce->{webworkDirs}->{root},	1396	$ce->{webworkDirs}->{root},
…		…
811	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1401	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
812	}	1402	}
813		1403
814	print CGI::h2("Export Database");	1404	print CGI::h2("Export Database");
815		1405
816	print CGI::start_form("POST", $r->uri);	1406	print CGI::start_form("GET", $r->uri);
817	print $self->hidden_authen_fields;	1407	print $self->hidden_authen_fields;
818	print $self->hidden_fields("subDisplay");	1408	print $self->hidden_fields("subDisplay");
819		1409
820	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.");
821		1414
822	print CGI::table({class=>"FormLayout"},	1415	print CGI::table({class=>"FormLayout"},
823	CGI::Tr(	1416	CGI::Tr(
824	CGI::th({class=>"LeftHeader"}, "Course Name:"),	1417	CGI::th({class=>"LeftHeader"}, "Course Name:"),
825	CGI::td(	1418	CGI::td(
826	CGI::scrolling_list(	1419	CGI::scrolling_list(
827	-name => "export_courseID",	1420	-name => "export_courseID",
828	-values => \@courseIDs,	1421	-values => \@courseIDs,
829	-default => $export_courseID,	1422	-default => $export_courseID,
830	-size => 10,	1423	-size => 10,
831	-multiple => 0,	1424	-multiple => 1,
832	-labels => \%courseLabels,	1425	-labels => \%courseLabels,
833	),	1426	),
834	),	1427	),
835	),	1428	),
836	CGI::Tr(	1429	CGI::Tr(
…		…
857	#my $ce = $r->ce;	1450	#my $ce = $r->ce;
858	#my $db = $r->db;	1451	#my $db = $r->db;
859	#my $authz = $r->authz;	1452	#my $authz = $r->authz;
860	#my $urlpath = $r->urlpath;	1453	#my $urlpath = $r->urlpath;
861		1454
862	my $export_courseID = $r->param("export_courseID") \|\| "";	1455	my @export_courseID = $r->param("export_courseID") \|\| ();
863	my @export_tables = $r->param("export_tables");	1456	my @export_tables = $r->param("export_tables");
864		1457
865	my @errors;	1458	my @errors;
866		1459
867	if ($export_courseID eq "") {	1460	unless ( @export_courseID) {
868	push @errors, "You must specify a course name.";	1461	push @errors, "You must specify at least one course name.";
869	}	1462	}
870		1463
871	unless (@export_tables) {	1464	unless (@export_tables) {
872	push @errors, "You must specify at least one table to export.";	1465	push @errors, "You must specify at least one table to export.";
873	}	1466	}
…		…
881	my $ce = $r->ce;	1474	my $ce = $r->ce;
882	#my $db = $r->db;	1475	#my $db = $r->db;
883	#my $authz = $r->authz;	1476	#my $authz = $r->authz;
884	my $urlpath = $r->urlpath;	1477	my $urlpath = $r->urlpath;
885		1478
886	my $export_courseID = $r->param("export_courseID");	1479	my @export_courseID = $r->param("export_courseID");
887	my @export_tables = $r->param("export_tables");	1480	my @export_tables = $r->param("export_tables");
888		1481
		1482	foreach my $export_courseID (@export_courseID) {
		1483
889	my $ce2 = WeBWorK::CourseEnvironment->new(	1484	my $ce2 = WeBWorK::CourseEnvironment->new(
890	$ce->{webworkDirs}->{root},	1485	$ce->{webworkDirs}->{root},
891	$ce->{webworkURLs}->{root},	1486	$ce->{webworkURLs}->{root},
892	$ce->{pg}->{directories}->{root},	1487	$ce->{pg}->{directories}->{root},
893	$export_courseID,	1488	$export_courseID,
894	);	1489	);
895		1490
896	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1491	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
897		1492
898	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});
899	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	}
900		1513
		1514	my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
		1515
901	my @errors;	1516	my @errors;
902
903	eval {	1517	eval {
904	@errors = dbExport(	1518	@errors = dbExport(
905	db => $db2,	1519	db => $db2,
906	xml => $fh,	1520	#xml => $fh,
		1521	xml => $outputFileHandle,
907	tables => \@export_tables,	1522	tables => \@export_tables,
908	);	1523	);
909	};	1524	};
		1525
		1526	$outputFileHandle->close();
910		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
911	push @errors, "Fatal exception: $@" if $@;	1537	#push @errors, "Fatal exception: $@" if $@;
912		1538	#
913	if (@errors) {	1539	#if (@errors) {
914	print CGI::div({class=>"ResultsWithError"},	1540	# print CGI::div({class=>"ResultsWithError"},
915	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:"),
916	CGI::ul(CGI::li(\@errors)),	1542	# CGI::ul(CGI::li(\@errors)),
917	);	1543	# );
918	} else {	1544	#} else {
919	print CGI::div({class=>"ResultsWithoutError"},	1545	# print CGI::div({class=>"ResultsWithoutError"},
920	CGI::p("Export succeeded."),	1546	# CGI::p("Export succeeded."),
921	);	1547	# );
922		1548	#
923	print CGI::div({style=>"text-align: center"},	1549	# print CGI::div({style=>"text-align: center"},
924	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"),
925	);	1551	# );
926	}	1552	#}
927	}	1553	}
928		1554
929	################################################################################	1555	################################################################################
930		1556
931	sub import_database_form {	1557	sub import_database_form {
…		…
944	my $import_conflict = $r->param("import_conflict") \|\| "skip";	1570	my $import_conflict = $r->param("import_conflict") \|\| "skip";
945		1571
946	@import_tables = @tables unless @import_tables;	1572	@import_tables = @tables unless @import_tables;
947		1573
948	my @courseIDs = listCourses($ce);	1574	my @courseIDs = listCourses($ce);
949	@courseIDs = sort @courseIDs;	1575	@courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
950		1576
951		1577
952	my %courseLabels; # records... heh.	1578	my %courseLabels; # records... heh.
953	foreach my $courseID (@courseIDs) {	1579	foreach my $courseID (@courseIDs) {
954	my $tempCE = WeBWorK::CourseEnvironment->new(	1580	my $tempCE = WeBWorK::CourseEnvironment->new(
…		…
958	$courseID,	1584	$courseID,
959	);	1585	);
960	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";	1586	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
961	}	1587	}
962		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
963	print CGI::h2("Import Database");	1606	print CGI::h2("Import Database");
964		1607
965	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);	1608	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
966	print $self->hidden_authen_fields;	1609	print $self->hidden_authen_fields;
967	print $self->hidden_fields("subDisplay");	1610	print $self->hidden_fields("subDisplay");
968		1611
969	print CGI::table({class=>"FormLayout"},	1612	print CGI::table({class=>"FormLayout"},
970	CGI::Tr(	1613	CGI::Tr(
971	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	# ),
972	CGI::td(	1621	CGI::td(
973	CGI::filefield(	1622	CGI::scrolling_list(
974	-name => "import_file",	1623	-name => "import_file",
		1624	-values => \@databaseFiles,
		1625	-default => undef,
975	-size => 50,	1626	-size => 10,
		1627	-multiple => 0,
		1628	-labels => \%databaseLabels,
976	),	1629	),
		1630
977	),	1631	)
978	),	1632	),
979	CGI::Tr(	1633	CGI::Tr(
980	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),	1634	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
981	CGI::td(	1635	CGI::td(
982	CGI::checkbox_group(	1636	CGI::checkbox_group(
…		…
1036	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked	1690	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
1037		1691
1038	my @errors;	1692	my @errors;
1039		1693
1040	if ($import_file eq "") {	1694	if ($import_file eq "") {
1041	push @errors, "You must specify a database file to upload.";	1695	push @errors, "You must specify a database file to import.";
1042	}	1696	}
1043		1697
1044	if ($import_courseID eq "") {	1698	if ($import_courseID eq "") {
1045	push @errors, "You must specify a course name.";	1699	push @errors, "You must specify a course name.";
1046	}	1700	}
…		…
1072	$import_courseID,	1726	$import_courseID,
1073	);	1727	);
1074		1728
1075	my $db2 = new WeBWorK::DB($ce2->{dbLayout});	1729	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1076		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");
1077	# retrieve upload from upload cache	1741	# retrieve upload from upload cache
1078	my ($id, $hash) = split /\s+/, $import_file;	1742	# my ($id, $hash) = split /\s+/, $import_file;
1079	my $upload = WeBWorK::Upload->retrieve($id, $hash,	1743	# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1080	dir => $ce->{webworkDirs}->{uploadCache}	1744	# dir => $ce->{webworkDirs}->{uploadCache}
1081	);	1745	# );
1082		1746
1083	my @errors;	1747	my @errors;
1084		1748
1085	eval {	1749	eval {
1086	@errors = dbImport(	1750	@errors = dbImport(
1087	db => $db2,	1751	db => $db2,
1088	xml => $upload->fileHandle,	1752	# xml => $upload->fileHandle,
		1753	xml => $fileHandle,
1089	tables => \@import_tables,	1754	tables => \@import_tables,
1090	conflict => $import_conflict,	1755	conflict => $import_conflict,
1091	);	1756	);
1092	};	1757	};
1093		1758
1094	$upload->dispose;
1095
1096	push @errors, "Fatal exception: $@" if $@;	1759	push @errors, "Fatal exception: $@" if $@;
		1760	push @errors, $gunzipMessage if $gunzipMessage;
1097		1761
1098	if (@errors) {	1762	if (@errors) {
1099	print CGI::div({class=>"ResultsWithError"},	1763	print CGI::div({class=>"ResultsWithError"},
1100	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:"),
1101	CGI::ul(CGI::li(\@errors)),	1765	CGI::ul(CGI::li(\@errors)),
…		…
1104	print CGI::div({class=>"ResultsWithoutError"},	1768	print CGI::div({class=>"ResultsWithoutError"},
1105	CGI::p("Import succeeded."),	1769	CGI::p("Import succeeded."),
1106	);	1770	);
1107	}	1771	}
1108	}	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	}
1109		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	. "? All course files and data and the following database will be destroyed."
		1952	. " There is no undo available.");
		1953
		1954	print CGI::table({class=>"FormLayout"},
		1955	CGI::Tr(
		1956	CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
		1957	CGI::td($archive_sql_host \|\| "system default"),
		1958	),
		1959	CGI::Tr(
		1960	CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
		1961	CGI::td($archive_sql_port \|\| "system default"),
		1962	),
		1963	CGI::Tr(
		1964	CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
		1965	CGI::td($archive_sql_database \|\| "webwork_$archive_courseID"),
		1966	),
		1967	);
		1968	} else {
		1969	print CGI::p("Are you sure you want to archive the course " . CGI::b($archive_courseID)
		1970	. "? All course files and data will be destroyed. There is no undo available.");
		1971	}
		1972
		1973	print CGI::start_form("POST", $r->uri);
		1974	print $self->hidden_authen_fields;
		1975	print $self->hidden_fields("subDisplay");
		1976	print $self->hidden_fields(qw/archive_courseID archive_sql_host archive_sql_port archive_sql_username archive_sql_password archive_sql_database/);
		1977
		1978	print CGI::p({style=>"text-align: center"},
		1979	CGI::submit("decline_archive_course", "Don't archive"),
		1980	" ",
		1981	CGI::submit("confirm_archive_course", "archive"),
		1982	);
		1983
		1984	print CGI::end_form();
		1985	}
		1986
		1987	sub do_archive_course {
		1988	my ($self) = @_;
		1989	my $r = $self->r;
		1990	my $ce = $r->ce;
		1991	#my $db = $r->db;
		1992	#my $authz = $r->authz;
		1993	#my $urlpath = $r->urlpath;
		1994
		1995	my $archive_courseID = $r->param("archive_courseID") \|\| "";
		1996	my $archive_sql_host = $r->param("archive_sql_host") \|\| "";
		1997	my $archive_sql_port = $r->param("archive_sql_port") \|\| "";
		1998	my $archive_sql_username = $r->param("archive_sql_username") \|\| "";
		1999	my $archive_sql_password = $r->param("archive_sql_password") \|\| "";
		2000	my $archive_sql_database = $r->param("archive_sql_database") \|\| "";
		2001
		2002	my $ce2 = WeBWorK::CourseEnvironment->new(
		2003	$ce->{webworkDirs}->{root},
		2004	$ce->{webworkURLs}->{root},
		2005	$ce->{pg}->{directories}->{root},
		2006	$archive_courseID,
		2007	);
		2008
		2009	my %dbOptions;
		2010	if ($ce2->{dbLayoutName} eq "sql") {
		2011	$dbOptions{host} = $archive_sql_host if $archive_sql_host ne "";
		2012	$dbOptions{port} = $archive_sql_port if $archive_sql_port ne "";
		2013	$dbOptions{username} = $archive_sql_username;
		2014	$dbOptions{password} = $archive_sql_password;
		2015	$dbOptions{database} = $archive_sql_database \|\| "webwork_$archive_courseID";
		2016	}
		2017
		2018	eval {
		2019	archiveCourse(
		2020	courseID => $archive_courseID,
		2021	ce => $ce2,
		2022	dbOptions => \%dbOptions,
		2023	);
		2024	};
		2025
		2026	if ($@) {
		2027	my $error = $@;
		2028	print CGI::div({class=>"ResultsWithError"},
		2029	CGI::p("An error occured while archiving the course $archive_courseID:"),
		2030	CGI::tt(CGI::escapeHTML($error)),
		2031	);
		2032	} else {
		2033	print CGI::div({class=>"ResultsWithoutError"},
		2034	CGI::p("Successfully archived the course $archive_courseID"),
		2035	);
		2036	writeLog($ce, "hosted_courses", join("\t",
		2037	"\tarchived",
		2038	"",
		2039	"",
		2040	$archive_courseID,
		2041	));
		2042	print CGI::start_form("POST", $r->uri);
		2043	print $self->hidden_authen_fields;
		2044	print $self->hidden_fields("subDisplay");
		2045
		2046	print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "OK"),);
		2047
		2048	print CGI::end_form();
		2049	}
		2050	}
		2051
		2052	################################################################################
1110	1;	2053	1;

 Legend:



Removed from v.2189
 


changed lines


 
Added in v.3528
 Legend:



Removed from v.2189
 


changed lines


 
Added in v.3528
-Removed from v.2189
+Added in v.3528

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9