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

Revision 3437		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.36 2005/07/14 13:15:25 glarose 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.
…		…
29	use Data::Dumper;	29	use Data::Dumper;
30	use File::Temp qw/tempfile/;	30	use File::Temp qw/tempfile/;
31	use WeBWorK::CourseEnvironment;	31	use WeBWorK::CourseEnvironment;
32	use IO::File;	32	use IO::File;
33	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);	33	use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
34	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses);	34	use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse);
35	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);	35	use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
36		36
37	# put the following database layouts at the top of the list, in this order	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/;	38	our @DB_LAYOUT_ORDER = qw/sql_single gdbm sql/;
39		39
…		…
163	} else {	163	} else {
164	$method_to_call = "import_database_form";	164	$method_to_call = "import_database_form";
165	}	165	}
166	}	166	}
167		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
168	else {	191	else {
169	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";	192	@errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
170	}	193	}
171		194
172	}	195	}
…		…
250	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"),
251	" \| ",	274	" \| ",
252	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"),
253	" \| ",	276	" \| ",
254	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"),
255	CGI::hr(),	280	CGI::hr(),
256	$methodMessage,	281	$methodMessage,
257		282
258	);	283	);
259		284
…		…
1743	print CGI::div({class=>"ResultsWithoutError"},	1768	print CGI::div({class=>"ResultsWithoutError"},
1744	CGI::p("Import succeeded."),	1769	CGI::p("Import succeeded."),
1745	);	1770	);
1746	}	1771	}
1747	}	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	}
1748		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	################################################################################
1749	1;	2053	1;

 Legend:



Removed from v.3437
 


changed lines


 
Added in v.3528
 Legend:



Removed from v.3437
 


changed lines


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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9