[system] / branches / rel-2-4-patches / webwork-modperl / lib / WeBWorK / ContentGenerator / CourseAdmin.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 2373 - (view) (download) (as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

1 : sh002i 1945 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 : sh002i 2373 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.18 2004/06/16 01:58:03 gage Exp $
5 : sh002i 1945 #
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
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.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :     # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :     # Artistic License for more details.
15 :     ################################################################################
16 :    
17 :     package WeBWorK::ContentGenerator::CourseAdmin;
18 :     use base qw(WeBWorK::ContentGenerator);
19 :    
20 :     =head1 NAME
21 :    
22 :     WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses.
23 :    
24 :     =cut
25 :    
26 :     use strict;
27 :     use warnings;
28 :     use CGI::Pretty qw();
29 :     use Data::Dumper;
30 : sh002i 1985 use File::Temp qw/tempfile/;
31 : sh002i 2138 use WeBWorK::CourseEnvironment;
32 : gage 2242 use WeBWorK::Utils qw(cryptPassword writeLog);
33 : sh002i 1960 use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses);
34 : sh002i 1985 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
35 : sh002i 1945
36 : sh002i 1985 sub pre_header_initialize {
37 :     my ($self) = @_;
38 :     my $r = $self->r;
39 :     my $ce = $r->ce;
40 :     my $db = $r->db;
41 :     my $authz = $r->authz;
42 :     my $urlpath = $r->urlpath;
43 : gage 2026 my $user = $r->param('user');
44 : sh002i 1985
45 : gage 2026 # check permissions
46 :     unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47 :     $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48 :     return;
49 :     }
50 :    
51 : sh002i 1985 if (defined $r->param("download_exported_database")) {
52 :     my $courseID = $r->param("export_courseID");
53 :     my $random_chars = $r->param("download_exported_database");
54 :    
55 :     die "courseID not specified" unless defined $courseID;
56 :     die "invalid file specification" unless $random_chars =~ m/^\w+$/;
57 :    
58 :     my $tempdir = $ce->{webworkDirs}->{tmp};
59 :     my $export_file = "$tempdir/db_export_$random_chars";
60 :    
61 :     $self->reply_with_file("text/xml", $export_file, "${courseID}_database.xml", 0);
62 :     }
63 :     }
64 : sh002i 1945
65 :     sub body {
66 :     my ($self) = @_;
67 :     my $r = $self->r;
68 :     my $ce = $r->ce;
69 :     my $db = $r->db;
70 :     my $authz = $r->authz;
71 :     my $urlpath = $r->urlpath;
72 :    
73 : gage 2026 my $user = $r->param('user');
74 :    
75 :     # check permissions
76 :     unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
77 :     return "";
78 :     }
79 :    
80 : sh002i 1960 print CGI::p({style=>"text-align: center"},
81 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
82 :     #" | ",
83 :     #CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
84 :     " | ",
85 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
86 : sh002i 1985 " | ",
87 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
88 :     " | ",
89 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
90 : sh002i 1960 );
91 : sh002i 1945
92 : sh002i 1960 print CGI::hr();
93 : sh002i 1945
94 : sh002i 1960 my $subDisplay = $r->param("subDisplay");
95 :     if (defined $subDisplay) {
96 : sh002i 1945
97 : sh002i 1960 if ($subDisplay eq "add_course") {
98 :     if (defined $r->param("add_course")) {
99 :     my @errors = $self->add_course_validate;
100 :     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 : sh002i 1985 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"},
181 :     "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.");
182 :     }
183 :    
184 : sh002i 1960 }
185 : sh002i 1945
186 : sh002i 1960 return "";
187 :     }
188 :    
189 : sh002i 1985 ################################################################################
190 :    
191 : sh002i 1960 sub add_course_form {
192 :     my ($self) = @_;
193 :     my $r = $self->r;
194 :     my $ce = $r->ce;
195 :     #my $db = $r->db;
196 :     #my $authz = $r->authz;
197 :     #my $urlpath = $r->urlpath;
198 : sh002i 1945
199 : gage 2254 my $add_courseID = $r->param("add_courseID") || "";
200 :     my $add_dbLayout = $r->param("add_dbLayout") || "";
201 :     my $add_sql_host = $r->param("add_sql_host") || "";
202 :     my $add_sql_port = $r->param("add_sql_port") || "";
203 :     my $add_sql_username = $r->param("add_sql_username") || "";
204 :     my $add_sql_password = $r->param("add_sql_password") || "";
205 :     my $add_sql_database = $r->param("add_sql_database") || "";
206 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
207 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
208 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
209 :     my $add_initial_password = $r->param("add_initial_password") || "";
210 :     my $add_initial_password_confirm = $r->param("add_initial_password_confirm") || "";
211 :     my $add_feedback_email = $r->param("add_feedback_email") || "";
212 :     my $add_templates_course = $r->param("add_templates_course") || "";
213 : gage 2299 my $add_contact_first_name = $r->param("add_contact_first_name") || "";
214 :     my $add_contact_last_name = $r->param("add_contact_last_name") || "";
215 : gage 2254 my $add_contact_institution = $r->param("add_contact_institution") || "";
216 :     my $add_course_title = $r->param("add_course_title") || "";
217 :     my $add_contact_email = $r->param("add_contact_email") || "";
218 :     my $add_admin_userID = $r->param("add_admin_userID") || $r->param("user") || "";
219 :     my $add_admin_password = $r->param("add_admin_password") || "";
220 : sh002i 1945
221 : sh002i 1960 my @dbLayouts = sort keys %{ $ce->{dbLayouts} };
222 :    
223 :     my $ce2 = WeBWorK::CourseEnvironment->new(
224 :     $ce->{webworkDirs}->{root},
225 :     $ce->{webworkURLs}->{root},
226 :     $ce->{pg}->{directories}->{root},
227 :     "COURSENAME",
228 :     );
229 :    
230 :     my $dbi_source = do {
231 :     # find the most common SQL source (stolen from CourseManagement.pm)
232 :     my %sources;
233 :     foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
234 :     $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
235 : sh002i 1945 }
236 : sh002i 1960 my $source;
237 :     if (keys %sources > 1) {
238 :     foreach my $curr (keys %sources) {
239 : jj 2023 $source = $curr if not defined $source or
240 :     $sources{$curr} > $sources{$source};
241 : sh002i 1960 }
242 :     } else {
243 :     ($source) = keys %sources;
244 :     }
245 :     $source;
246 :     };
247 : sh002i 1945
248 : gage 2322 my @existingCourses = listCourses($ce);
249 :     @existingCourses = sort @existingCourses;
250 : sh002i 2148
251 : sh002i 1960 print CGI::h2("Add Course");
252 : sh002i 1945
253 : sh002i 1960 print CGI::start_form("POST", $r->uri);
254 :     print $self->hidden_authen_fields;
255 :     print $self->hidden_fields("subDisplay");
256 : sh002i 1945
257 : sh002i 1960 print CGI::p("Specify a name for the new course.");
258 :    
259 :     print CGI::table({class=>"FormLayout"},
260 :     CGI::Tr(
261 : gage 2242 CGI::th({class=>"LeftHeader"}, "Course ID:"),
262 : sh002i 1960 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
263 : gage 2242 CGI::th({class=>"LeftHeader"}, "Course Title"),
264 :     CGI::td(CGI::textfield("add_course_title", $add_course_title, 25)),
265 : sh002i 1960 ),
266 :     );
267 :    
268 : gage 2242 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.");
269 :    
270 :     print CGI::table({class=>"FormLayout"},
271 :     CGI::Tr(
272 : gage 2254 CGI::th({class=>"CenterHeader"}, "Instructor ID"),
273 :     CGI::th({class=>"CenterHeader"}, "Instructor Password"),
274 :     CGI::th({class=>"CenterHeader"}, "Confirm Instructor Password"),
275 : gage 2242
276 : gage 2254
277 : gage 2242 ),
278 :     CGI::Tr(
279 :     CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID || "professor", 25)),
280 :     CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
281 : gage 2254 CGI::td(CGI::password_field("add_initial_password_confirm", $add_initial_password_confirm, 25)),
282 :    
283 : gage 2242 ),
284 :    
285 :     CGI::Tr(
286 : gage 2299 CGI::th({class=>"CenterHeader"}, "First name"),
287 :     CGI::th({class=>"CenterHeader"}, "Last name"),
288 :     CGI::th({class=>"CenterHeader"}, " "),
289 :     ),
290 :     CGI::Tr(
291 :     CGI::td(CGI::textfield("add_contact_first_name", $add_contact_first_name, 20)),
292 :     CGI::td(CGI::textfield("add_contact_last_name", $add_contact_last_name, 20)),
293 :     CGI::th({class=>"CenterHeader"}, " "),
294 :     ),
295 :     CGI::Tr(
296 : gage 2242 CGI::th({class=>"CenterHeader"}, "Contact institution"),
297 :     CGI::th({class=>"CenterHeader"}, "Contact e-mail"),
298 : gage 2299 CGI::th({class=>"CenterHeader"}, " "),
299 : gage 2242 ),
300 :     CGI::Tr(
301 :     CGI::td(CGI::textfield("add_contact_institution", $add_contact_institution, 35)),
302 :     CGI::td(CGI::textfield("add_contact_email", $add_contact_email, 35)),
303 : gage 2299 CGI::th({class=>"CenterHeader"}, " "),
304 : gage 2242 ),
305 :     CGI::Tr(
306 : gage 2254 CGI::th({class=>"CenterHeader"}, "Administrator ID"),
307 : gage 2242 CGI::th({class=>"CenterHeader"}, "Administrator Password"),
308 : gage 2254 CGI::th({class=>"CenterHeader"}, "Feedback e-mail"),
309 : gage 2242
310 :     ),
311 :     CGI::Tr(
312 :     CGI::td(CGI::textfield("add_admin_userID", $add_admin_userID, 25)),
313 :     CGI::td(CGI::password_field("add_admin_password", $add_admin_password, 25)),
314 : gage 2254 CGI::td(CGI::textfield("add_feedback_email", $add_feedback_email, 25)),
315 : gage 2299
316 : gage 2242 ),
317 :     );
318 : gage 2254
319 :     print CGI::p("Select an existing course from which to copy templates:");
320 :    
321 :     print CGI::table({class=>"FormLayout"},
322 :     CGI::Tr(
323 :     CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
324 :     CGI::td(
325 :     CGI::popup_menu(
326 :     -name => "add_templates_course",
327 :     -values => [ "", @existingCourses ],
328 :     -default => $add_templates_course,
329 :     #-size => 10,
330 :     #-multiple => 0,
331 :     #-labels => \%courseLabels,
332 :     ),
333 :    
334 :     ),
335 :     ),
336 :     );
337 :    
338 : sh002i 1960 print CGI::p("Select a database layout below. Some database layouts require additional information.");
339 :    
340 :     #print CGI::start_Tr();
341 :     #print CGI::th({class=>"LeftHeader"}, "Database Layout:");
342 :     #print CGI::start_td();
343 :    
344 :     foreach my $dbLayout (@dbLayouts) {
345 :     print CGI::start_table({class=>"FormLayout"});
346 :    
347 :     # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
348 :     print CGI::Tr(
349 :     CGI::td({style=>"text-align: right"},
350 :     '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
351 :     . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
352 : sh002i 1945 ),
353 : sh002i 1960 CGI::td($dbLayout),
354 : sh002i 1945 );
355 :    
356 : sh002i 1960 print CGI::start_Tr();
357 :     print CGI::td(); # for indentation :(
358 :     print CGI::start_td();
359 : sh002i 1945
360 : sh002i 1960 if ($dbLayout eq "sql") {
361 : gage 2254
362 :     print CGI::start_table({class=>"FormLayout"});
363 :     print CGI::Tr(CGI::td({colspan=>2},
364 :     "The SQL Admin is a user in the SQL database with sufficient permissions to create a new database."
365 :     )
366 : sh002i 1960 );
367 : sh002i 1945 print CGI::Tr(
368 : gage 2254 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
369 :     CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
370 :     );
371 :     print CGI::Tr(
372 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
373 :     CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
374 :     );
375 :    
376 :     print CGI::Tr(CGI::td({colspan=>2}, CGI::hr(),
377 :     "The optionial SQL settings you enter below must match the settings in the DBI source",
378 :     " specification ", CGI::tt($dbi_source), ". Replace ", CGI::tt("COURSENAME"),
379 :     " with the course name you entered above."
380 :     )
381 :     );
382 :     print CGI::Tr(
383 : sh002i 1945 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
384 :     CGI::td(
385 : sh002i 1960 CGI::textfield("add_sql_host", $add_sql_host, 25),
386 : sh002i 1945 CGI::br(),
387 :     CGI::small("Leave blank to use the default host."),
388 :     ),
389 :     );
390 :     print CGI::Tr(
391 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
392 :     CGI::td(
393 : sh002i 1960 CGI::textfield("add_sql_port", $add_sql_port, 25),
394 : sh002i 1945 CGI::br(),
395 :     CGI::small("Leave blank to use the default port."),
396 :     ),
397 :     );
398 : gage 2254
399 : sh002i 1945 print CGI::Tr(
400 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
401 : sh002i 2104 CGI::td(
402 :     CGI::textfield("add_sql_database", $add_sql_database, 25),
403 :     CGI::br(),
404 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
405 :     ),
406 : sh002i 1945 );
407 :     print CGI::Tr(
408 :     CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
409 :     CGI::td(
410 : sh002i 1960 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25),
411 : sh002i 1945 CGI::br(),
412 :     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."),
413 :     ),
414 :     );
415 : sh002i 1960 print CGI::end_table();
416 :     } elsif ($dbLayout eq "gdbm") {
417 : sh002i 1945 print CGI::start_table({class=>"FormLayout"});
418 :     print CGI::Tr(
419 :     CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
420 : sh002i 2004 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)),
421 : sh002i 1945 );
422 : sh002i 1960 print CGI::end_table();
423 : sh002i 1945 }
424 :    
425 : sh002i 1960 print CGI::end_td();
426 :     print CGI::end_Tr();
427 : sh002i 1945 print CGI::end_table();
428 :     }
429 :    
430 : sh002i 1960
431 :    
432 :    
433 : gage 2242
434 : sh002i 2148
435 :    
436 : sh002i 1960 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
437 :    
438 :     print CGI::end_form();
439 :     }
440 :    
441 :     sub add_course_validate {
442 :     my ($self) = @_;
443 :     my $r = $self->r;
444 :     my $ce = $r->ce;
445 :     #my $db = $r->db;
446 :     #my $authz = $r->authz;
447 :     #my $urlpath = $r->urlpath;
448 :    
449 : gage 2254 my $add_courseID = $r->param("add_courseID") || "";
450 :     my $add_dbLayout = $r->param("add_dbLayout") || "";
451 :     my $add_sql_host = $r->param("add_sql_host") || "";
452 :     my $add_sql_port = $r->param("add_sql_port") || "";
453 :     my $add_sql_username = $r->param("add_sql_username") || "";
454 :     my $add_sql_password = $r->param("add_sql_password") || "";
455 :     my $add_sql_database = $r->param("add_sql_database") || "";
456 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
457 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
458 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
459 :     my $add_initial_password = $r->param("add_initial_password") || "";
460 :     my $add_initial_password_confirm = $r->param("add_initial_password_confirm") || "";
461 :     my $add_templates_course = $r->param("add_templates_course") || "";
462 : gage 2299 my $add_contact_first_name = $r->param("add_contact_first_name") || "";
463 :     my $add_contact_last_name = $r->param("add_contact_last_name") || "";
464 : gage 2254 my $add_contact_institution = $r->param("add_contact_institution") || "";
465 :     my $add_contact_email = $r->param("add_contact_email") || "";
466 :     my $add_course_title = $r->param("add_course_title") || "";
467 :     my $add_admin_userID = $r->param("add_admin_userID") || "";
468 :     my $add_admin_password = $r->param("add_admin_password") || "";
469 : gage 2242
470 : sh002i 1960 my @errors;
471 :    
472 :     if ($add_courseID eq "") {
473 :     push @errors, "You must specify a course name.";
474 :     }
475 : sh002i 2373 if (grep { $add_courseID eq $_ } listCourses($ce)) {
476 :     push @errors, "A course named $add_courseID already exists." ;
477 :     }
478 : gage 2242 if ($add_contact_institution eq "") {
479 :     push @errors, "You must specify a contact institution." ;
480 :     }
481 : gage 2299 if ($add_contact_last_name eq "") {
482 : gage 2242 push @errors, "You must specify a contact person.";
483 :     }
484 :     if ($add_contact_email eq "") {
485 :     push @errors, "You must specify an email address for the contact person." ;
486 :     }
487 : gage 2254 if ($add_initial_password ne $add_initial_password_confirm) {
488 :     push @errors, "The instructor's passwords don't match";
489 :     }
490 : gage 2242 if ($add_course_title eq "") {
491 :     push @errors, "You must specify a title for the course.";
492 :     }
493 : sh002i 1960
494 :     if ($add_dbLayout eq "") {
495 :     push @errors, "You must select a database layout.";
496 :     } else {
497 :     if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
498 :     if ($add_dbLayout eq "sql") {
499 :     push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
500 : sh002i 2104 #push @errors, "You must specify the SQL admin password." if $add_sql_password eq "";
501 :     #push @errors, "You must specify the SQL database name." if $add_sql_database eq "";
502 : sh002i 1960 push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
503 :     } elsif ($add_dbLayout eq "gdbm") {
504 :     push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
505 :     }
506 :     } else {
507 :     push @errors, "The database layout $add_dbLayout doesn't exist.";
508 :     }
509 :     }
510 :    
511 :     if ($add_initial_userID ne "") {
512 :     push @errors, "You must specify a professor password." if $add_initial_password eq "";
513 :     }
514 : gage 2242 if ($add_admin_userID ne "") {
515 :     push @errors, "You must specify an admin password for $add_admin_userID." if $add_admin_password eq "";
516 :     }
517 : sh002i 1960
518 :     return @errors;
519 :     }
520 :    
521 :     sub do_add_course {
522 :     my ($self) = @_;
523 :     my $r = $self->r;
524 :     my $ce = $r->ce;
525 :     my $db = $r->db;
526 :     #my $authz = $r->authz;
527 :     my $urlpath = $r->urlpath;
528 :    
529 : gage 2299 my $add_courseID = $r->param("add_courseID") || "";
530 :     my $add_dbLayout = $r->param("add_dbLayout") || "";
531 :     my $add_sql_host = $r->param("add_sql_host") || "";
532 :     my $add_sql_port = $r->param("add_sql_port") || "";
533 :     my $add_sql_username = $r->param("add_sql_username") || "";
534 :     my $add_sql_password = $r->param("add_sql_password") || "";
535 :     my $add_sql_database = $r->param("add_sql_database") || "";
536 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
537 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
538 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
539 :     my $add_initial_password = $r->param("add_initial_password") || "";
540 :     my $add_templates_course = $r->param("add_templates_course") || "";
541 :     my $add_contact_first_name = $r->param("add_contact_first_name") || "";
542 :     my $add_contact_last_name = $r->param("add_contact_last_name") || "";
543 :     my $add_contact_institution = $r->param("add_contact_institution") || "";
544 :     my $add_contact_email = $r->param("add_contact_email") || "";
545 :     my $add_course_title = $r->param("add_course_title") || "";
546 :     my $add_admin_userID = $r->param("add_admin_userID") || $r->param("user") || "";
547 :     my $add_admin_password = $r->param("add_admin_password") || "";
548 : gage 2242
549 : sh002i 1960 my $ce2 = WeBWorK::CourseEnvironment->new(
550 :     $ce->{webworkDirs}->{root},
551 :     $ce->{webworkURLs}->{root},
552 :     $ce->{pg}->{directories}->{root},
553 :     $add_courseID,
554 :     );
555 :    
556 : gage 2042 my %courseOptions = ( dbLayoutName => $add_dbLayout );
557 : sh002i 2004 if ($add_dbLayout eq "gdbm") {
558 :     $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
559 :     }
560 :    
561 : sh002i 1960 my %dbOptions;
562 :     if ($add_dbLayout eq "sql") {
563 :     $dbOptions{host} = $add_sql_host if $add_sql_host ne "";
564 :     $dbOptions{port} = $add_sql_port if $add_sql_port ne "";
565 :     $dbOptions{username} = $add_sql_username;
566 :     $dbOptions{password} = $add_sql_password;
567 : sh002i 2104 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID";
568 : sh002i 1960 $dbOptions{wwhost} = $add_sql_wwhost;
569 :     }
570 : gage 2242 # add professor and administor if defined.
571 : sh002i 1960 my @users;
572 :     if ($add_initial_userID ne "") {
573 : sh002i 2004 my $User = $db->newUser(
574 : gage 2322 user_id => $add_initial_userID,
575 :     last_name => $add_contact_last_name,
576 :     first_name => $add_contact_first_name,
577 :     student_id => $add_initial_userID,
578 :     status => "C",
579 : sh002i 2004 );
580 : gage 2322 # $User->last_name( $add_contact_last_name );
581 :     # $User->first_name( $add_contact_first_name );
582 :     # $User->student_id( $add_initial_userID );
583 : sh002i 2004 my $Password = $db->newPassword(
584 : sh002i 1960 user_id => $add_initial_userID,
585 :     password => cryptPassword($add_initial_password),
586 : sh002i 2004 );
587 :     my $PermissionLevel = $db->newPermissionLevel(
588 : sh002i 1960 user_id => $add_initial_userID,
589 :     permission => "10",
590 : sh002i 2004 );
591 :     push @users, [ $User, $Password, $PermissionLevel ];
592 : sh002i 1960 }
593 : gage 2242 if ($add_admin_userID ne "") {
594 :     my $User = $db->newUser(
595 :     user_id => $add_admin_userID,
596 : gage 2322 last_name => " Administrator",
597 :     first_name => "Sir",
598 :     student_id => $add_admin_userID,
599 : gage 2242 status => "C",
600 :     );
601 :     my $Password = $db->newPassword(
602 :     user_id => $add_admin_userID,
603 :     password => cryptPassword($add_admin_password),
604 :     );
605 :     my $PermissionLevel = $db->newPermissionLevel(
606 :     user_id => $add_admin_userID,
607 :     permission => "10",
608 :     );
609 :     push @users, [ $User, $Password, $PermissionLevel ];
610 :     }
611 : sh002i 2148 my %optional_arguments;
612 :     if ($add_templates_course ne "") {
613 :     $optional_arguments{templatesFrom} = $add_templates_course;
614 :     }
615 :    
616 : sh002i 1960 eval {
617 :     addCourse(
618 : sh002i 2004 courseID => $add_courseID,
619 :     ce => $ce2,
620 :     courseOptions => \%courseOptions,
621 :     dbOptions => \%dbOptions,
622 :     users => \@users,
623 : sh002i 2148 %optional_arguments,
624 : sh002i 1945 );
625 : sh002i 1960 };
626 :    
627 :     if ($@) {
628 :     my $error = $@;
629 :     print CGI::div({class=>"ResultsWithError"},
630 :     CGI::p("An error occured while creating the course $add_courseID:"),
631 :     CGI::tt(CGI::escapeHTML($error)),
632 :     );
633 : gage 2254 # get rid of any partially built courses
634 :     # FIXME -- this is too fragile
635 :     unless ($error =~ /course exists/) {
636 :     eval {
637 :     deleteCourse(
638 :     courseID => $add_courseID,
639 :     ce => $ce2,
640 :     dbOptions => \%dbOptions,
641 :     );
642 :     }
643 :     }
644 : sh002i 1960 } else {
645 : gage 2256 #log the action
646 : gage 2242 writeLog($ce, "hosted_courses", join("\t",
647 :     "\tAdded",
648 :     $add_contact_institution,
649 :     $add_course_title,
650 :     $add_courseID,
651 : gage 2299 $add_contact_first_name,
652 :     $add_contact_last_name,
653 : gage 2242 $add_contact_email,
654 :     ));
655 : gage 2256 # add contact to admin course as student?
656 :     # FIXME -- should we do this?
657 : sh002i 1960 print CGI::div({class=>"ResultsWithoutError"},
658 :     CGI::p("Successfully created the course $add_courseID"),
659 :     );
660 :     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
661 :     courseID => $add_courseID);
662 :     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
663 :     print CGI::div({style=>"text-align: center"},
664 :     CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
665 :     );
666 :     }
667 : gage 2322
668 : gage 2299
669 : sh002i 1960 }
670 :    
671 :     ################################################################################
672 :    
673 :     sub delete_course_form {
674 :     my ($self) = @_;
675 :     my $r = $self->r;
676 :     my $ce = $r->ce;
677 :     #my $db = $r->db;
678 :     #my $authz = $r->authz;
679 :     #my $urlpath = $r->urlpath;
680 :    
681 :     my $delete_courseID = $r->param("delete_courseID") || "";
682 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
683 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
684 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
685 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
686 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
687 :    
688 :     my @courseIDs = listCourses($ce);
689 : gage 2045 @courseIDs = sort @courseIDs;
690 : sh002i 1960
691 :     my %courseLabels; # records... heh.
692 :     foreach my $courseID (@courseIDs) {
693 :     my $tempCE = WeBWorK::CourseEnvironment->new(
694 :     $ce->{webworkDirs}->{root},
695 :     $ce->{webworkURLs}->{root},
696 :     $ce->{pg}->{directories}->{root},
697 :     $courseID,
698 :     );
699 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
700 :     }
701 :    
702 :     print CGI::h2("Delete Course");
703 :    
704 :     print CGI::start_form("POST", $r->uri);
705 :     print $self->hidden_authen_fields;
706 :     print $self->hidden_fields("subDisplay");
707 :    
708 :     print CGI::p("Select a course to delete.");
709 :    
710 :     print CGI::table({class=>"FormLayout"},
711 :     CGI::Tr(
712 :     CGI::th({class=>"LeftHeader"}, "Course Name:"),
713 : sh002i 1945 CGI::td(
714 : sh002i 1960 CGI::scrolling_list(
715 :     -name => "delete_courseID",
716 :     -values => \@courseIDs,
717 :     -default => $delete_courseID,
718 :     -size => 10,
719 :     -multiple => 0,
720 :     -labels => \%courseLabels,
721 : sh002i 1945 ),
722 :     ),
723 : sh002i 1960 ),
724 :     );
725 :    
726 :     print CGI::p(
727 :     "If the course's database layout (indicated in parentheses above) is "
728 :     . CGI::b("sql") . ", supply the SQL connections information requested below."
729 :     );
730 :    
731 :     print CGI::start_table({class=>"FormLayout"});
732 :     print CGI::Tr(
733 :     CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
734 :     CGI::td(
735 :     CGI::textfield("delete_sql_host", $delete_sql_host, 25),
736 :     CGI::br(),
737 :     CGI::small("Leave blank to use the default host."),
738 :     ),
739 :     );
740 :     print CGI::Tr(
741 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
742 :     CGI::td(
743 :     CGI::textfield("delete_sql_port", $delete_sql_port, 25),
744 :     CGI::br(),
745 :     CGI::small("Leave blank to use the default port."),
746 :     ),
747 :     );
748 :     print CGI::Tr(
749 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
750 :     CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
751 :     );
752 :     print CGI::Tr(
753 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
754 :     CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
755 :     );
756 :     print CGI::Tr(
757 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
758 : sh002i 2189 CGI::td(
759 :     CGI::textfield("delete_sql_database", $delete_sql_database, 25),
760 :     CGI::br(),
761 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
762 :     ),
763 : sh002i 1960 );
764 :     print CGI::end_table();
765 :    
766 :     print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
767 :    
768 :     print CGI::end_form();
769 :     }
770 :    
771 :     sub delete_course_validate {
772 :     my ($self) = @_;
773 :     my $r = $self->r;
774 :     my $ce = $r->ce;
775 :     #my $db = $r->db;
776 :     #my $authz = $r->authz;
777 :     my $urlpath = $r->urlpath;
778 :    
779 :     my $delete_courseID = $r->param("delete_courseID") || "";
780 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
781 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
782 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
783 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
784 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
785 :    
786 :     my @errors;
787 :    
788 :     if ($delete_courseID eq "") {
789 :     push @errors, "You must specify a course name.";
790 :     } elsif ($delete_courseID eq $urlpath->arg("courseID")) {
791 :     push @errors, "You cannot delete the course you are currently using.";
792 :     }
793 :    
794 :     my $ce2 = WeBWorK::CourseEnvironment->new(
795 :     $ce->{webworkDirs}->{root},
796 :     $ce->{webworkURLs}->{root},
797 :     $ce->{pg}->{directories}->{root},
798 :     $delete_courseID,
799 :     );
800 :    
801 :     if ($ce2->{dbLayoutName} eq "sql") {
802 :     push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
803 : sh002i 2189 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
804 :     #push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
805 : sh002i 1960 }
806 :    
807 :     return @errors;
808 :     }
809 :    
810 :     sub delete_course_confirm {
811 :     my ($self) = @_;
812 :     my $r = $self->r;
813 :     my $ce = $r->ce;
814 :     #my $db = $r->db;
815 :     #my $authz = $r->authz;
816 :     #my $urlpath = $r->urlpath;
817 :    
818 :     print CGI::h2("Delete Course");
819 :    
820 :     my $delete_courseID = $r->param("delete_courseID") || "";
821 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
822 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
823 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
824 :    
825 :     my $ce2 = WeBWorK::CourseEnvironment->new(
826 :     $ce->{webworkDirs}->{root},
827 :     $ce->{webworkURLs}->{root},
828 :     $ce->{pg}->{directories}->{root},
829 :     $delete_courseID,
830 :     );
831 :    
832 :     if ($ce2->{dbLayoutName} eq "sql") {
833 :     print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
834 :     . "? All course files and data and the following database will be destroyed."
835 :     . " There is no undo available.");
836 :    
837 :     print CGI::table({class=>"FormLayout"},
838 :     CGI::Tr(
839 :     CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
840 :     CGI::td($delete_sql_host || "system default"),
841 : sh002i 1945 ),
842 : sh002i 1960 CGI::Tr(
843 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
844 :     CGI::td($delete_sql_port || "system default"),
845 :     ),
846 :     CGI::Tr(
847 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
848 : sh002i 2189 CGI::td($delete_sql_database || "webwork_$delete_courseID"),
849 : sh002i 1960 ),
850 : sh002i 1945 );
851 : sh002i 1960 } else {
852 :     print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
853 :     . "? All course files and data will be destroyed. There is no undo available.");
854 : sh002i 1945 }
855 :    
856 : sh002i 1960 print CGI::start_form("POST", $r->uri);
857 :     print $self->hidden_authen_fields;
858 :     print $self->hidden_fields("subDisplay");
859 :     print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
860 :    
861 :     print CGI::p({style=>"text-align: center"},
862 :     CGI::submit("decline_delete_course", "Don't delete"),
863 :     "&nbsp;",
864 :     CGI::submit("confirm_delete_course", "Delete"),
865 :     );
866 :    
867 :     print CGI::end_form();
868 :     }
869 :    
870 :     sub do_delete_course {
871 :     my ($self) = @_;
872 :     my $r = $self->r;
873 :     my $ce = $r->ce;
874 :     #my $db = $r->db;
875 :     #my $authz = $r->authz;
876 :     #my $urlpath = $r->urlpath;
877 :    
878 :     my $delete_courseID = $r->param("delete_courseID") || "";
879 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
880 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
881 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
882 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
883 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
884 :    
885 :     my $ce2 = WeBWorK::CourseEnvironment->new(
886 :     $ce->{webworkDirs}->{root},
887 :     $ce->{webworkURLs}->{root},
888 :     $ce->{pg}->{directories}->{root},
889 :     $delete_courseID,
890 :     );
891 :    
892 :     my %dbOptions;
893 :     if ($ce2->{dbLayoutName} eq "sql") {
894 :     $dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
895 :     $dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
896 :     $dbOptions{username} = $delete_sql_username;
897 :     $dbOptions{password} = $delete_sql_password;
898 : sh002i 2189 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID";
899 : sh002i 1960 }
900 :    
901 :     eval {
902 :     deleteCourse(
903 :     courseID => $delete_courseID,
904 :     ce => $ce2,
905 :     dbOptions => \%dbOptions,
906 :     );
907 :     };
908 :    
909 :     if ($@) {
910 :     my $error = $@;
911 :     print CGI::div({class=>"ResultsWithError"},
912 :     CGI::p("An error occured while deleting the course $delete_courseID:"),
913 :     CGI::tt(CGI::escapeHTML($error)),
914 :     );
915 :     } else {
916 :     print CGI::div({class=>"ResultsWithoutError"},
917 :     CGI::p("Possibly deleted the course $delete_courseID. (We need better error checking in deleteCourse().)"),
918 :     );
919 : gage 2242 writeLog($ce, "hosted_courses", join("\t",
920 :     "\tDeleted",
921 :     "",
922 :     "",
923 :     $delete_courseID,
924 :     ));
925 : sh002i 1945 print CGI::start_form("POST", $r->uri);
926 :     print $self->hidden_authen_fields;
927 : sh002i 1960 print $self->hidden_fields("subDisplay");
928 : sh002i 1945
929 : sh002i 1960 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
930 : sh002i 1945
931 : sh002i 1960 print CGI::end_form();
932 : sh002i 1945 }
933 :     }
934 :    
935 : sh002i 1985 ################################################################################
936 :    
937 :     sub export_database_form {
938 :     my ($self) = @_;
939 :     my $r = $self->r;
940 :     my $ce = $r->ce;
941 :     #my $db = $r->db;
942 :     #my $authz = $r->authz;
943 :     #my $urlpath = $r->urlpath;
944 :    
945 :     my @tables = keys %{$ce->{dbLayout}};
946 :    
947 :     my $export_courseID = $r->param("export_courseID") || "";
948 :     my @export_tables = $r->param("export_tables");
949 :    
950 :     @export_tables = @tables unless @export_tables;
951 :    
952 :     my @courseIDs = listCourses($ce);
953 : gage 2045 @courseIDs = sort @courseIDs;
954 : sh002i 1985
955 :     my %courseLabels; # records... heh.
956 :     foreach my $courseID (@courseIDs) {
957 :     my $tempCE = WeBWorK::CourseEnvironment->new(
958 :     $ce->{webworkDirs}->{root},
959 :     $ce->{webworkURLs}->{root},
960 :     $ce->{pg}->{directories}->{root},
961 :     $courseID,
962 :     );
963 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
964 :     }
965 :    
966 :     print CGI::h2("Export Database");
967 :    
968 :     print CGI::start_form("POST", $r->uri);
969 :     print $self->hidden_authen_fields;
970 :     print $self->hidden_fields("subDisplay");
971 :    
972 :     print CGI::p("Select a course to export the course's database.");
973 :    
974 :     print CGI::table({class=>"FormLayout"},
975 :     CGI::Tr(
976 :     CGI::th({class=>"LeftHeader"}, "Course Name:"),
977 :     CGI::td(
978 :     CGI::scrolling_list(
979 :     -name => "export_courseID",
980 :     -values => \@courseIDs,
981 :     -default => $export_courseID,
982 :     -size => 10,
983 :     -multiple => 0,
984 :     -labels => \%courseLabels,
985 :     ),
986 :     ),
987 :     ),
988 :     CGI::Tr(
989 :     CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
990 :     CGI::td(
991 :     CGI::checkbox_group(
992 :     -name => "export_tables",
993 :     -values => \@tables,
994 :     -default => \@export_tables,
995 :     -linebreak => 1,
996 :     ),
997 :     ),
998 :     ),
999 :     );
1000 :    
1001 :     print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
1002 :    
1003 :     print CGI::end_form();
1004 :     }
1005 :    
1006 :     sub export_database_validate {
1007 :     my ($self) = @_;
1008 :     my $r = $self->r;
1009 :     #my $ce = $r->ce;
1010 :     #my $db = $r->db;
1011 :     #my $authz = $r->authz;
1012 :     #my $urlpath = $r->urlpath;
1013 :    
1014 :     my $export_courseID = $r->param("export_courseID") || "";
1015 :     my @export_tables = $r->param("export_tables");
1016 :    
1017 :     my @errors;
1018 :    
1019 :     if ($export_courseID eq "") {
1020 :     push @errors, "You must specify a course name.";
1021 :     }
1022 :    
1023 :     unless (@export_tables) {
1024 :     push @errors, "You must specify at least one table to export.";
1025 :     }
1026 :    
1027 :     return @errors;
1028 :     }
1029 :    
1030 :     sub do_export_database {
1031 :     my ($self) = @_;
1032 :     my $r = $self->r;
1033 :     my $ce = $r->ce;
1034 :     #my $db = $r->db;
1035 :     #my $authz = $r->authz;
1036 :     my $urlpath = $r->urlpath;
1037 :    
1038 :     my $export_courseID = $r->param("export_courseID");
1039 :     my @export_tables = $r->param("export_tables");
1040 :    
1041 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1042 :     $ce->{webworkDirs}->{root},
1043 :     $ce->{webworkURLs}->{root},
1044 :     $ce->{pg}->{directories}->{root},
1045 :     $export_courseID,
1046 :     );
1047 :    
1048 :     my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1049 :    
1050 :     my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1051 :     my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1052 :    
1053 :     my @errors;
1054 :    
1055 :     eval {
1056 :     @errors = dbExport(
1057 :     db => $db2,
1058 :     xml => $fh,
1059 :     tables => \@export_tables,
1060 :     );
1061 :     };
1062 :    
1063 :     push @errors, "Fatal exception: $@" if $@;
1064 :    
1065 :     if (@errors) {
1066 :     print CGI::div({class=>"ResultsWithError"},
1067 :     CGI::p("An error occured while exporting the database of course $export_courseID:"),
1068 :     CGI::ul(CGI::li(\@errors)),
1069 :     );
1070 :     } else {
1071 :     print CGI::div({class=>"ResultsWithoutError"},
1072 :     CGI::p("Export succeeded."),
1073 :     );
1074 :    
1075 :     print CGI::div({style=>"text-align: center"},
1076 :     CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1077 :     );
1078 :     }
1079 :     }
1080 :    
1081 :     ################################################################################
1082 :    
1083 :     sub import_database_form {
1084 :     my ($self) = @_;
1085 :     my $r = $self->r;
1086 :     my $ce = $r->ce;
1087 :     #my $db = $r->db;
1088 :     #my $authz = $r->authz;
1089 :     #my $urlpath = $r->urlpath;
1090 :    
1091 :     my @tables = keys %{$ce->{dbLayout}};
1092 :    
1093 :     my $import_file = $r->param("import_file") || "";
1094 :     my $import_courseID = $r->param("import_courseID") || "";
1095 :     my @import_tables = $r->param("import_tables");
1096 :     my $import_conflict = $r->param("import_conflict") || "skip";
1097 :    
1098 :     @import_tables = @tables unless @import_tables;
1099 :    
1100 :     my @courseIDs = listCourses($ce);
1101 : gage 2045 @courseIDs = sort @courseIDs;
1102 :    
1103 : sh002i 1985
1104 :     my %courseLabels; # records... heh.
1105 :     foreach my $courseID (@courseIDs) {
1106 :     my $tempCE = WeBWorK::CourseEnvironment->new(
1107 :     $ce->{webworkDirs}->{root},
1108 :     $ce->{webworkURLs}->{root},
1109 :     $ce->{pg}->{directories}->{root},
1110 :     $courseID,
1111 :     );
1112 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1113 :     }
1114 :    
1115 :     print CGI::h2("Import Database");
1116 :    
1117 :     print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1118 :     print $self->hidden_authen_fields;
1119 :     print $self->hidden_fields("subDisplay");
1120 :    
1121 :     print CGI::table({class=>"FormLayout"},
1122 :     CGI::Tr(
1123 :     CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1124 :     CGI::td(
1125 :     CGI::filefield(
1126 :     -name => "import_file",
1127 :     -size => 50,
1128 :     ),
1129 :     ),
1130 :     ),
1131 :     CGI::Tr(
1132 :     CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1133 :     CGI::td(
1134 :     CGI::checkbox_group(
1135 :     -name => "import_tables",
1136 :     -values => \@tables,
1137 :     -default => \@import_tables,
1138 :     -linebreak => 1,
1139 :     ),
1140 :     ),
1141 :     ),
1142 :     CGI::Tr(
1143 :     CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1144 :     CGI::td(
1145 :     CGI::scrolling_list(
1146 :     -name => "import_courseID",
1147 :     -values => \@courseIDs,
1148 :     -default => $import_courseID,
1149 :     -size => 10,
1150 :     -multiple => 0,
1151 :     -labels => \%courseLabels,
1152 :     ),
1153 :     ),
1154 :     ),
1155 :     CGI::Tr(
1156 :     CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1157 :     CGI::td(
1158 :     CGI::radio_group(
1159 :     -name => "import_conflict",
1160 :     -values => [qw/skip replace/],
1161 :     -default => $import_conflict,
1162 :     -linebreak=>'true',
1163 :     -labels => {
1164 :     skip => "Skip duplicate records",
1165 :     replace => "Replace duplicate records",
1166 :     },
1167 :     ),
1168 :     ),
1169 :     ),
1170 :     );
1171 :    
1172 :     print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1173 :    
1174 :     print CGI::end_form();
1175 :     }
1176 :    
1177 :     sub import_database_validate {
1178 :     my ($self) = @_;
1179 :     my $r = $self->r;
1180 :     #my $ce = $r->ce;
1181 :     #my $db = $r->db;
1182 :     #my $authz = $r->authz;
1183 :     #my $urlpath = $r->urlpath;
1184 :    
1185 :     my $import_file = $r->param("import_file") || "";
1186 :     my $import_courseID = $r->param("import_courseID") || "";
1187 :     my @import_tables = $r->param("import_tables");
1188 :     #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked
1189 :    
1190 :     my @errors;
1191 :    
1192 :     if ($import_file eq "") {
1193 :     push @errors, "You must specify a database file to upload.";
1194 :     }
1195 :    
1196 :     if ($import_courseID eq "") {
1197 :     push @errors, "You must specify a course name.";
1198 :     }
1199 :    
1200 :     unless (@import_tables) {
1201 :     push @errors, "You must specify at least one table to import.";
1202 :     }
1203 :    
1204 :     return @errors;
1205 :     }
1206 :    
1207 :     sub do_import_database {
1208 :     my ($self) = @_;
1209 :     my $r = $self->r;
1210 :     my $ce = $r->ce;
1211 :     #my $db = $r->db;
1212 :     #my $authz = $r->authz;
1213 :     my $urlpath = $r->urlpath;
1214 :    
1215 :     my $import_file = $r->param("import_file");
1216 :     my $import_courseID = $r->param("import_courseID");
1217 :     my @import_tables = $r->param("import_tables");
1218 :     my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above
1219 :    
1220 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1221 :     $ce->{webworkDirs}->{root},
1222 :     $ce->{webworkURLs}->{root},
1223 :     $ce->{pg}->{directories}->{root},
1224 :     $import_courseID,
1225 :     );
1226 :    
1227 :     my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1228 :    
1229 :     # retrieve upload from upload cache
1230 :     my ($id, $hash) = split /\s+/, $import_file;
1231 :     my $upload = WeBWorK::Upload->retrieve($id, $hash,
1232 :     dir => $ce->{webworkDirs}->{uploadCache}
1233 :     );
1234 :    
1235 :     my @errors;
1236 :    
1237 :     eval {
1238 :     @errors = dbImport(
1239 :     db => $db2,
1240 :     xml => $upload->fileHandle,
1241 :     tables => \@import_tables,
1242 :     conflict => $import_conflict,
1243 :     );
1244 :     };
1245 :    
1246 :     $upload->dispose;
1247 :    
1248 :     push @errors, "Fatal exception: $@" if $@;
1249 :    
1250 :     if (@errors) {
1251 :     print CGI::div({class=>"ResultsWithError"},
1252 :     CGI::p("An error occured while importing the database of course $import_courseID:"),
1253 :     CGI::ul(CGI::li(\@errors)),
1254 :     );
1255 :     } else {
1256 :     print CGI::div({class=>"ResultsWithoutError"},
1257 :     CGI::p("Import succeeded."),
1258 :     );
1259 :     }
1260 :     }
1261 :    
1262 : sh002i 1945 1;
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9