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

Revision 1984		Revision 1985
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/Skeleton.pm,v 1.2 2004/03/15 21:13:06 sh002i Exp $	4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.2 2004/04/09 20:19:25 sh002i Exp $
5	#	5	#
6	# This program is free software; you can redistribute it and/or modify it under	6	# This program is free software; you can redistribute it and/or modify it under
7	# the terms of either: (a) the GNU General Public License as published by the	7	# the terms of either: (a) the GNU General Public License as published by the
8	# Free Software Foundation; either version 2, or (at your option) any later	8	# Free Software Foundation; either version 2, or (at your option) any later
9	# version, or (b) the "Artistic License" which comes with this package.	9	# version, or (b) the "Artistic License" which comes with this package.
…		…
25		25
26	use strict;	26	use strict;
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 WeBWorK::Utils qw(cryptPassword);	31	use WeBWorK::Utils qw(cryptPassword);
31	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);	32	use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);
		33	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
32		34
33	# SKEL: If you need to do any processing before the HTTP header is sent, do it	35	# SKEL: If you need to do any processing before the HTTP header is sent, do it
34	# in this method:	36	# in this method:
35	#	37	#
36	#sub pre_header_initialize {	38	sub pre_header_initialize {
37	# my ($self) = @_;	39	my ($self) = @_;
38	#	40	my $r = $self->r;
39	# # Do your processing here! Don't print or return anything -- store data in	41	my $ce = $r->ce;
40	# # the self hash for later retrieveal.	42	my $db = $r->db;
41	#}	43	my $authz = $r->authz;
		44	my $urlpath = $r->urlpath;
		45
		46	if (defined $r->param("download_exported_database")) {
		47	my $courseID = $r->param("export_courseID");
		48	my $random_chars = $r->param("download_exported_database");
		49
		50	die "courseID not specified" unless defined $courseID;
		51	die "invalid file specification" unless $random_chars =~ m/^\w+$/;
		52
		53	my $tempdir = $ce->{webworkDirs}->{tmp};
		54	my $export_file = "$tempdir/db_export_$random_chars";
		55
		56	$self->reply_with_file("text/xml", $export_file, "${courseID}_database.xml", 0);
		57	}
		58	}
42		59
43	# SKEL: To emit your own HTTP header, uncomment this:	60	# SKEL: To emit your own HTTP header, uncomment this:
44	#	61	#
45	#sub header {	62	#sub header {
46	# my ($self) = @_;	63	# my ($self) = @_;
…		…
133	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),	150	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
134	#" \| ",	151	#" \| ",
135	#CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),	152	#CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
136	" \| ",	153	" \| ",
137	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),	154	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
		155	" \| ",
		156	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
		157	" \| ",
		158	CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
138	);	159	);
139		160
140	print CGI::hr();	161	print CGI::hr();
141		162
142	my $subDisplay = $r->param("subDisplay");	163	my $subDisplay = $r->param("subDisplay");
…		…
188	# form only	209	# form only
189	$self->delete_course_form;	210	$self->delete_course_form;
190	}	211	}
191	}	212	}
192		213
		214	elsif ($subDisplay eq "export_database") {
		215	if (defined $r->param("export_database")) {
		216	my @errors = $self->export_database_validate;
		217	if (@errors) {
		218	print CGI::div({class=>"ResultsWithError"},
		219	CGI::p("Please correct the following errors and try again:"),
		220	CGI::ul(CGI::li(\@errors)),
		221	);
		222	$self->export_database_form;
		223	} else {
		224	$self->do_export_database;
		225	}
		226	} else {
		227	$self->export_database_form;
		228	}
		229	}
		230
		231	elsif ($subDisplay eq "import_database") {
		232	if (defined $r->param("import_database")) {
		233	my @errors = $self->import_database_validate;
		234	if (@errors) {
		235	print CGI::div({class=>"ResultsWithError"},
		236	CGI::p("Please correct the following errors and try again:"),
		237	CGI::ul(CGI::li(\@errors)),
		238	);
		239	$self->import_database_form;
		240	} else {
		241	$self->do_import_database;
		242	}
		243	} else {
		244	$self->import_database_form;
		245	}
		246	}
		247
		248	else {
		249	print CGI::div({class=>"ResultsWithError"},
		250	"Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.");
		251	}
		252
193	}	253	}
194		254
195	return "";	255	return "";
196	}	256	}
		257
		258	################################################################################
197		259
198	sub add_course_form {	260	sub add_course_form {
199	my ($self) = @_;	261	my ($self) = @_;
200	my $r = $self->r;	262	my $r = $self->r;
201	my $ce = $r->ce;	263	my $ce = $r->ce;
…		…
596	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";	658	my $delete_sql_port = $r->param("delete_sql_port") \|\| "";
597	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";	659	my $delete_sql_username = $r->param("delete_sql_username") \|\| "";
598	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";	660	my $delete_sql_password = $r->param("delete_sql_password") \|\| "";
599	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";	661	my $delete_sql_database = $r->param("delete_sql_database") \|\| "";
600		662
601	my @courseIDs = listCourses($ce);
602
603	my %courseLabels; # records... heh.
604	foreach my $courseID (@courseIDs) {
605	my $tempCE = WeBWorK::CourseEnvironment->new(
606	$ce->{webworkDirs}->{root},
607	$ce->{webworkURLs}->{root},
608	$ce->{pg}->{directories}->{root},
609	$courseID,
610	);
611	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
612	}
613
614	my @errors;	663	my @errors;
615		664
616	if ($delete_courseID eq "") {	665	if ($delete_courseID eq "") {
617	push @errors, "You must specify a course name.";	666	push @errors, "You must specify a course name.";
618	} elsif ($delete_courseID eq $urlpath->arg("courseID")) {	667	} elsif ($delete_courseID eq $urlpath->arg("courseID")) {
…		…
753		802
754	print CGI::end_form();	803	print CGI::end_form();
755	}	804	}
756	}	805	}
757		806
		807	################################################################################
		808
		809	sub export_database_form {
		810	my ($self) = @_;
		811	my $r = $self->r;
		812	my $ce = $r->ce;
		813	#my $db = $r->db;
		814	#my $authz = $r->authz;
		815	#my $urlpath = $r->urlpath;
		816
		817	my @tables = keys %{$ce->{dbLayout}};
		818
		819	my $export_courseID = $r->param("export_courseID") \|\| "";
		820	my @export_tables = $r->param("export_tables");
		821
		822	@export_tables = @tables unless @export_tables;
		823
		824	my @courseIDs = listCourses($ce);
		825
		826	my %courseLabels; # records... heh.
		827	foreach my $courseID (@courseIDs) {
		828	my $tempCE = WeBWorK::CourseEnvironment->new(
		829	$ce->{webworkDirs}->{root},
		830	$ce->{webworkURLs}->{root},
		831	$ce->{pg}->{directories}->{root},
		832	$courseID,
		833	);
		834	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		835	}
		836
		837	print CGI::h2("Export Database");
		838
		839	print CGI::start_form("POST", $r->uri);
		840	print $self->hidden_authen_fields;
		841	print $self->hidden_fields("subDisplay");
		842
		843	print CGI::p("Select a course to export the course's database.");
		844
		845	print CGI::table({class=>"FormLayout"},
		846	CGI::Tr(
		847	CGI::th({class=>"LeftHeader"}, "Course Name:"),
		848	CGI::td(
		849	CGI::scrolling_list(
		850	-name => "export_courseID",
		851	-values => \@courseIDs,
		852	-default => $export_courseID,
		853	-size => 10,
		854	-multiple => 0,
		855	-labels => \%courseLabels,
		856	),
		857	),
		858	),
		859	CGI::Tr(
		860	CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
		861	CGI::td(
		862	CGI::checkbox_group(
		863	-name => "export_tables",
		864	-values => \@tables,
		865	-default => \@export_tables,
		866	-linebreak => 1,
		867	),
		868	),
		869	),
		870	);
		871
		872	print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
		873
		874	print CGI::end_form();
		875	}
		876
		877	sub export_database_validate {
		878	my ($self) = @_;
		879	my $r = $self->r;
		880	#my $ce = $r->ce;
		881	#my $db = $r->db;
		882	#my $authz = $r->authz;
		883	#my $urlpath = $r->urlpath;
		884
		885	my $export_courseID = $r->param("export_courseID") \|\| "";
		886	my @export_tables = $r->param("export_tables");
		887
		888	my @errors;
		889
		890	if ($export_courseID eq "") {
		891	push @errors, "You must specify a course name.";
		892	}
		893
		894	unless (@export_tables) {
		895	push @errors, "You must specify at least one table to export.";
		896	}
		897
		898	return @errors;
		899	}
		900
		901	sub do_export_database {
		902	my ($self) = @_;
		903	my $r = $self->r;
		904	my $ce = $r->ce;
		905	#my $db = $r->db;
		906	#my $authz = $r->authz;
		907	my $urlpath = $r->urlpath;
		908
		909	my $export_courseID = $r->param("export_courseID");
		910	my @export_tables = $r->param("export_tables");
		911
		912	my $ce2 = WeBWorK::CourseEnvironment->new(
		913	$ce->{webworkDirs}->{root},
		914	$ce->{webworkURLs}->{root},
		915	$ce->{pg}->{directories}->{root},
		916	$export_courseID,
		917	);
		918
		919	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
		920
		921	my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
		922	my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
		923
		924	my @errors;
		925
		926	eval {
		927	@errors = dbExport(
		928	db => $db2,
		929	xml => $fh,
		930	tables => \@export_tables,
		931	);
		932	};
		933
		934	push @errors, "Fatal exception: $@" if $@;
		935
		936	if (@errors) {
		937	print CGI::div({class=>"ResultsWithError"},
		938	CGI::p("An error occured while exporting the database of course $export_courseID:"),
		939	CGI::ul(CGI::li(\@errors)),
		940	);
		941	} else {
		942	print CGI::div({class=>"ResultsWithoutError"},
		943	CGI::p("Export succeeded."),
		944	);
		945
		946	print CGI::div({style=>"text-align: center"},
		947	CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
		948	);
		949	}
		950	}
		951
		952	################################################################################
		953
		954	sub import_database_form {
		955	my ($self) = @_;
		956	my $r = $self->r;
		957	my $ce = $r->ce;
		958	#my $db = $r->db;
		959	#my $authz = $r->authz;
		960	#my $urlpath = $r->urlpath;
		961
		962	my @tables = keys %{$ce->{dbLayout}};
		963
		964	my $import_file = $r->param("import_file") \|\| "";
		965	my $import_courseID = $r->param("import_courseID") \|\| "";
		966	my @import_tables = $r->param("import_tables");
		967	my $import_conflict = $r->param("import_conflict") \|\| "skip";
		968
		969	@import_tables = @tables unless @import_tables;
		970
		971	my @courseIDs = listCourses($ce);
		972
		973	my %courseLabels; # records... heh.
		974	foreach my $courseID (@courseIDs) {
		975	my $tempCE = WeBWorK::CourseEnvironment->new(
		976	$ce->{webworkDirs}->{root},
		977	$ce->{webworkURLs}->{root},
		978	$ce->{pg}->{directories}->{root},
		979	$courseID,
		980	);
		981	$courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
		982	}
		983
		984	print CGI::h2("Import Database");
		985
		986	print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
		987	print $self->hidden_authen_fields;
		988	print $self->hidden_fields("subDisplay");
		989
		990	print CGI::table({class=>"FormLayout"},
		991	CGI::Tr(
		992	CGI::th({class=>"LeftHeader"}, "Database XML File:"),
		993	CGI::td(
		994	CGI::filefield(
		995	-name => "import_file",
		996	-size => 50,
		997	),
		998	),
		999	),
		1000	CGI::Tr(
		1001	CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
		1002	CGI::td(
		1003	CGI::checkbox_group(
		1004	-name => "import_tables",
		1005	-values => \@tables,
		1006	-default => \@import_tables,
		1007	-linebreak => 1,
		1008	),
		1009	),
		1010	),
		1011	CGI::Tr(
		1012	CGI::th({class=>"LeftHeader"}, "Import into Course:"),
		1013	CGI::td(
		1014	CGI::scrolling_list(
		1015	-name => "import_courseID",
		1016	-values => \@courseIDs,
		1017	-default => $import_courseID,
		1018	-size => 10,
		1019	-multiple => 0,
		1020	-labels => \%courseLabels,
		1021	),
		1022	),
		1023	),
		1024	CGI::Tr(
		1025	CGI::th({class=>"LeftHeader"}, "Conflicts:"),
		1026	CGI::td(
		1027	CGI::radio_group(
		1028	-name => "import_conflict",
		1029	-values => [qw/skip replace/],
		1030	-default => $import_conflict,
		1031	-linebreak=>'true',
		1032	-labels => {
		1033	skip => "Skip duplicate records",
		1034	replace => "Replace duplicate records",
		1035	},
		1036	),
		1037	),
		1038	),
		1039	);
		1040
		1041	print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
		1042
		1043	print CGI::end_form();
		1044	}
		1045
		1046	sub import_database_validate {
		1047	my ($self) = @_;
		1048	my $r = $self->r;
		1049	#my $ce = $r->ce;
		1050	#my $db = $r->db;
		1051	#my $authz = $r->authz;
		1052	#my $urlpath = $r->urlpath;
		1053
		1054	my $import_file = $r->param("import_file") \|\| "";
		1055	my $import_courseID = $r->param("import_courseID") \|\| "";
		1056	my @import_tables = $r->param("import_tables");
		1057	#my $import_conflict = $r->param("import_conflict") \|\| "skip"; # not checked
		1058
		1059	my @errors;
		1060
		1061	if ($import_file eq "") {
		1062	push @errors, "You must specify a database file to upload.";
		1063	}
		1064
		1065	if ($import_courseID eq "") {
		1066	push @errors, "You must specify a course name.";
		1067	}
		1068
		1069	unless (@import_tables) {
		1070	push @errors, "You must specify at least one table to import.";
		1071	}
		1072
		1073	return @errors;
		1074	}
		1075
		1076	sub do_import_database {
		1077	my ($self) = @_;
		1078	my $r = $self->r;
		1079	my $ce = $r->ce;
		1080	#my $db = $r->db;
		1081	#my $authz = $r->authz;
		1082	my $urlpath = $r->urlpath;
		1083
		1084	my $import_file = $r->param("import_file");
		1085	my $import_courseID = $r->param("import_courseID");
		1086	my @import_tables = $r->param("import_tables");
		1087	my $import_conflict = $r->param("import_conflict") \|\| "skip"; # need default -- not checked above
		1088
		1089	my $ce2 = WeBWorK::CourseEnvironment->new(
		1090	$ce->{webworkDirs}->{root},
		1091	$ce->{webworkURLs}->{root},
		1092	$ce->{pg}->{directories}->{root},
		1093	$import_courseID,
		1094	);
		1095
		1096	my $db2 = new WeBWorK::DB($ce2->{dbLayout});
		1097
		1098	# retrieve upload from upload cache
		1099	my ($id, $hash) = split /\s+/, $import_file;
		1100	my $upload = WeBWorK::Upload->retrieve($id, $hash,
		1101	dir => $ce->{webworkDirs}->{uploadCache}
		1102	);
		1103
		1104	my @errors;
		1105
		1106	eval {
		1107	@errors = dbImport(
		1108	db => $db2,
		1109	xml => $upload->fileHandle,
		1110	tables => \@import_tables,
		1111	conflict => $import_conflict,
		1112	);
		1113	};
		1114
		1115	$upload->dispose;
		1116
		1117	push @errors, "Fatal exception: $@" if $@;
		1118
		1119	if (@errors) {
		1120	print CGI::div({class=>"ResultsWithError"},
		1121	CGI::p("An error occured while importing the database of course $import_courseID:"),
		1122	CGI::ul(CGI::li(\@errors)),
		1123	);
		1124	} else {
		1125	print CGI::div({class=>"ResultsWithoutError"},
		1126	CGI::p("Import succeeded."),
		1127	);
		1128	}
		1129	}
		1130
758	1;	1131	1;

 Legend:



Removed from v.1984
 


changed lines


 
Added in v.1985
 Legend:



Removed from v.1984
 


changed lines


 
Added in v.1985
-Removed from v.1984
+Added in v.1985

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9