[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / CourseAdmin.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 3434 - (view) (download) (as text)

1 : sh002i 1945 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 : gage 3434 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.36 2005/07/14 13:15:25 glarose 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 3235 use IO::File;
33 :     use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
34 : sh002i 3059 use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses);
35 : sh002i 1985 use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
36 : sh002i 1945
37 : sh002i 2639 # 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 => "Deprecated. Uses GDBM databases to record WeBWorK data. Use this layout if the course must be used with WeBWorK 1.x.",
42 :     sql => "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 :     );
45 :    
46 : sh002i 1985 sub pre_header_initialize {
47 :     my ($self) = @_;
48 :     my $r = $self->r;
49 :     my $ce = $r->ce;
50 :     my $db = $r->db;
51 :     my $authz = $r->authz;
52 :     my $urlpath = $r->urlpath;
53 : gage 2026 my $user = $r->param('user');
54 : sh002i 1985
55 : gage 2026 # check permissions
56 :     unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
57 :     $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
58 :     return;
59 :     }
60 : sh002i 1945
61 : gage 3284 # get result and send to message
62 :     my $status_message = $r->param("status_message");
63 :     $self->addmessage(CGI::p("$status_message")) if $status_message;
64 :    
65 : sh002i 2478 ## if the user is asking for the downloaded database...
66 :     #if (defined $r->param("download_exported_database")) {
67 :     # my $courseID = $r->param("export_courseID");
68 :     # my $random_chars = $r->param("download_exported_database");
69 :     #
70 :     # die "courseID not specified" unless defined $courseID;
71 :     # die "invalid file specification" unless $random_chars =~ m/^\w+$/;
72 :     #
73 :     # my $tempdir = $ce->{webworkDirs}->{tmp};
74 :     # my $export_file = "$tempdir/db_export_$random_chars";
75 :     #
76 :     # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0);
77 :     #
78 :     # return "";
79 :     #}
80 :     #
81 :     ## otherwise...
82 : gage 2026
83 : sh002i 2478 my @errors;
84 :     my $method_to_call;
85 : gage 2026
86 : sh002i 1960 my $subDisplay = $r->param("subDisplay");
87 :     if (defined $subDisplay) {
88 : sh002i 1945
89 : sh002i 1960 if ($subDisplay eq "add_course") {
90 :     if (defined $r->param("add_course")) {
91 : sh002i 2478 @errors = $self->add_course_validate;
92 : sh002i 1960 if (@errors) {
93 : sh002i 2478 $method_to_call = "add_course_form";
94 : sh002i 1960 } else {
95 : sh002i 2478 $method_to_call = "do_add_course";
96 : sh002i 1960 }
97 :     } else {
98 : sh002i 2478 $method_to_call = "add_course_form";
99 : sh002i 1960 }
100 :     }
101 :    
102 : sh002i 3059 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 : sh002i 1960 elsif ($subDisplay eq "delete_course") {
116 :     if (defined $r->param("delete_course")) {
117 :     # validate or confirm
118 : sh002i 2478 @errors = $self->delete_course_validate;
119 : sh002i 1960 if (@errors) {
120 : sh002i 2478 $method_to_call = "delete_course_form";
121 : sh002i 1960 } else {
122 : sh002i 2478 $method_to_call = "delete_course_confirm";
123 : sh002i 1960 }
124 :     } elsif (defined $r->param("confirm_delete_course")) {
125 :     # validate and delete
126 : sh002i 2478 @errors = $self->delete_course_validate;
127 : sh002i 1960 if (@errors) {
128 : sh002i 2478 $method_to_call = "delete_course_form";
129 : sh002i 1960 } else {
130 : sh002i 2478 $method_to_call = "do_delete_course";
131 : sh002i 1960 }
132 :     } else {
133 :     # form only
134 : sh002i 2478 $method_to_call = "delete_course_form";
135 : sh002i 1960 }
136 :     }
137 :    
138 : sh002i 1985 elsif ($subDisplay eq "export_database") {
139 :     if (defined $r->param("export_database")) {
140 : sh002i 2478 @errors = $self->export_database_validate;
141 : sh002i 1985 if (@errors) {
142 : sh002i 2478 $method_to_call = "export_database_form";
143 : sh002i 1985 } else {
144 : sh002i 2478 # 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 : sh002i 1985 }
150 :     } else {
151 : sh002i 2478 $method_to_call = "export_database_form";
152 : sh002i 1985 }
153 :     }
154 :    
155 :     elsif ($subDisplay eq "import_database") {
156 :     if (defined $r->param("import_database")) {
157 : sh002i 2478 @errors = $self->import_database_validate;
158 : sh002i 1985 if (@errors) {
159 : sh002i 2478 $method_to_call = "import_database_form";
160 : sh002i 1985 } else {
161 : sh002i 2478 $method_to_call = "do_import_database";
162 : sh002i 1985 }
163 :     } else {
164 : sh002i 2478 $method_to_call = "import_database_form";
165 : sh002i 1985 }
166 :     }
167 :    
168 :     else {
169 : sh002i 2478 @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
170 : sh002i 1985 }
171 :    
172 : sh002i 1960 }
173 : sh002i 1945
174 : sh002i 2478 $self->{errors} = \@errors;
175 :     $self->{method_to_call} = $method_to_call;
176 :     }
177 :    
178 :     sub header {
179 :     my ($self) = @_;
180 :     my $method_to_call = $self->{method_to_call};
181 : gage 3235 # if (defined $method_to_call and $method_to_call eq "do_export_database") {
182 :     # my $r = $self->r;
183 :     # my $courseID = $r->param("export_courseID");
184 :     # $r->content_type("application/octet-stream");
185 :     # $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
186 :     # $r->send_http_header;
187 :     # } else {
188 : sh002i 2478 $self->SUPER::header;
189 : gage 3235 # }
190 : sh002i 2478 }
191 :    
192 :     # sends:
193 : sh002i 2479 #
194 : sh002i 2478 # HTTP/1.1 200 OK
195 :     # Date: Fri, 09 Jul 2004 19:05:55 GMT
196 :     # Server: Apache/1.3.27 (Unix) mod_perl/1.27
197 :     # Content-Disposition: attachment; filename="mth143_database.xml"
198 :     # Connection: close
199 :     # Content-Type: application/octet-stream
200 :    
201 :     sub content {
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 : gage 3235 #$self->do_export_database;
206 :     $self->SUPER::content;
207 : sh002i 2478 } else {
208 :     $self->SUPER::content;
209 :     }
210 :     }
211 :    
212 :     sub body {
213 :     my ($self) = @_;
214 :     my $r = $self->r;
215 :     my $ce = $r->ce;
216 :     my $db = $r->db;
217 :     my $authz = $r->authz;
218 :     my $urlpath = $r->urlpath;
219 :    
220 :     my $user = $r->param('user');
221 :    
222 :     # check permissions
223 :     unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
224 :     return "";
225 :     }
226 : gage 3235 my $method_to_call = $self->{method_to_call};
227 :     my $methodMessage ="";
228 : sh002i 2478
229 : gage 3235 (defined($method_to_call) and $method_to_call eq "do_export_database") && do {
230 :     my @export_courseID = $r->param("export_courseID");
231 :     my $course_ids = join(", ", @export_courseID);
232 :     $methodMessage = CGI::p("Exporting database for course(s) $course_ids").
233 :     CGI::p(".... please wait....
234 :     If your browser times out you will
235 :     still be able to download the exported database using the
236 :     file manager.").CGI::hr();
237 :     };
238 :    
239 :    
240 : sh002i 2478 print CGI::p({style=>"text-align: center"},
241 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
242 :     " | ",
243 : sh002i 3059 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
244 :     " | ",
245 : sh002i 2478 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
246 :     " | ",
247 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
248 :     " | ",
249 :     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
250 : gage 3235 CGI::hr(),
251 :     $methodMessage,
252 :    
253 : sh002i 2478 );
254 :    
255 : gage 3235 print CGI::p("The ability to import and to export databases is still under development.
256 :     It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
257 :     use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
258 :     Please send bug reports if you find errors. ");
259 : sh002i 2478
260 :     my @errors = @{$self->{errors}};
261 :    
262 : gage 3235
263 : sh002i 2478 if (@errors) {
264 :     print CGI::div({class=>"ResultsWithError"},
265 :     CGI::p("Please correct the following errors and try again:"),
266 :     CGI::ul(CGI::li(\@errors)),
267 :     );
268 :     }
269 :    
270 :     if (defined $method_to_call and $method_to_call ne "") {
271 :     $self->$method_to_call;
272 : gage 3434 } else {
273 :    
274 :     print CGI::h2("Courses");
275 :    
276 :     print CGI::start_ul();
277 :    
278 :     my @courseIDs = listCourses($ce);
279 :     foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
280 :     next if $courseID eq "admin"; # done already above
281 :     my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
282 :     my $tempCE = WeBWorK::CourseEnvironment->new(
283 :     $ce->{webworkDirs}->{root},
284 :     $ce->{webworkURLs}->{root},
285 :     $ce->{pg}->{directories}->{root},
286 :     $courseID,
287 :     );
288 :     print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
289 :     CGI::code(
290 :     $tempCE->{dbLayoutName},
291 :     ),
292 :     (-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"),
293 :    
294 :     );
295 :    
296 :     }
297 :    
298 :     print CGI::end_ul();
299 : sh002i 2478 }
300 : sh002i 1960 return "";
301 :     }
302 :    
303 : sh002i 1985 ################################################################################
304 :    
305 : sh002i 1960 sub add_course_form {
306 :     my ($self) = @_;
307 :     my $r = $self->r;
308 :     my $ce = $r->ce;
309 :     #my $db = $r->db;
310 :     #my $authz = $r->authz;
311 :     #my $urlpath = $r->urlpath;
312 : sh002i 1945
313 : gage 2254 my $add_courseID = $r->param("add_courseID") || "";
314 : sh002i 2378 my $add_courseTitle = $r->param("add_courseTitle") || "";
315 :     my $add_courseInstitution = $r->param("add_courseInstitution") || "";
316 :    
317 :     my $add_admin_users = $r->param("add_admin_users") || "";
318 :    
319 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
320 :     my $add_initial_password = $r->param("add_initial_password") || "";
321 :     my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || "";
322 :     my $add_initial_firstName = $r->param("add_initial_firstName") || "";
323 :     my $add_initial_lastName = $r->param("add_initial_lastName") || "";
324 :     my $add_initial_email = $r->param("add_initial_email") || "";
325 :    
326 :     my $add_templates_course = $r->param("add_templates_course") || "";
327 :    
328 : gage 2254 my $add_dbLayout = $r->param("add_dbLayout") || "";
329 :     my $add_sql_host = $r->param("add_sql_host") || "";
330 :     my $add_sql_port = $r->param("add_sql_port") || "";
331 :     my $add_sql_username = $r->param("add_sql_username") || "";
332 :     my $add_sql_password = $r->param("add_sql_password") || "";
333 :     my $add_sql_database = $r->param("add_sql_database") || "";
334 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
335 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
336 : sh002i 1945
337 : sh002i 2639 my @dbLayouts = do {
338 :     my @ordered_layouts;
339 :     foreach my $layout (@DB_LAYOUT_ORDER) {
340 :     if (exists $ce->{dbLayouts}->{$layout}) {
341 :     push @ordered_layouts, $layout;
342 :     }
343 :     }
344 :    
345 :     my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
346 :     my @other_layouts;
347 :     foreach my $layout (keys %{ $ce->{dbLayouts} }) {
348 :     unless (exists $ordered_layouts{$layout}) {
349 :     push @other_layouts, $layout;
350 :     }
351 :     }
352 :    
353 :     (@ordered_layouts, @other_layouts);
354 :     };
355 : sh002i 1960
356 :     my $ce2 = WeBWorK::CourseEnvironment->new(
357 :     $ce->{webworkDirs}->{root},
358 :     $ce->{webworkURLs}->{root},
359 :     $ce->{pg}->{directories}->{root},
360 :     "COURSENAME",
361 :     );
362 :    
363 :     my $dbi_source = do {
364 :     # find the most common SQL source (stolen from CourseManagement.pm)
365 :     my %sources;
366 :     foreach my $table (keys %{ $ce2->{dbLayouts}->{sql} }) {
367 :     $sources{$ce2->{dbLayouts}->{sql}->{$table}->{source}}++;
368 : sh002i 1945 }
369 : sh002i 1960 my $source;
370 :     if (keys %sources > 1) {
371 :     foreach my $curr (keys %sources) {
372 : jj 2023 $source = $curr if not defined $source or
373 :     $sources{$curr} > $sources{$source};
374 : sh002i 1960 }
375 :     } else {
376 :     ($source) = keys %sources;
377 :     }
378 :     $source;
379 :     };
380 : sh002i 1945
381 : sh002i 2378 my @existingCourses = listCourses($ce);
382 : gage 3434 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
383 : sh002i 2148
384 : sh002i 1960 print CGI::h2("Add Course");
385 : sh002i 1945
386 : sh002i 1960 print CGI::start_form("POST", $r->uri);
387 :     print $self->hidden_authen_fields;
388 :     print $self->hidden_fields("subDisplay");
389 : sh002i 1945
390 : sh002i 2378 print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores.");
391 : sh002i 1960
392 :     print CGI::table({class=>"FormLayout"},
393 :     CGI::Tr(
394 : gage 2242 CGI::th({class=>"LeftHeader"}, "Course ID:"),
395 : sh002i 1960 CGI::td(CGI::textfield("add_courseID", $add_courseID, 25)),
396 :     ),
397 : gage 2242 CGI::Tr(
398 : sh002i 2378 CGI::th({class=>"LeftHeader"}, "Course Title:"),
399 :     CGI::td(CGI::textfield("add_courseTitle", $add_courseTitle, 25)),
400 : gage 2242 ),
401 :     CGI::Tr(
402 : sh002i 2378 CGI::th({class=>"LeftHeader"}, "Institution:"),
403 :     CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
404 : gage 2242 ),
405 : sh002i 2378 );
406 :    
407 :     print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
408 :    
409 :     print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course"));
410 :    
411 :     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.");
412 :    
413 :     print CGI::table({class=>"FormLayout"}, CGI::Tr(
414 :     CGI::td(
415 :     CGI::table({class=>"FormLayout"},
416 :     CGI::Tr(
417 :     CGI::th({class=>"LeftHeader"}, "User ID:"),
418 :     CGI::td(CGI::textfield("add_initial_userID", $add_initial_userID, 25)),
419 :     ),
420 :     CGI::Tr(
421 :     CGI::th({class=>"LeftHeader"}, "Password:"),
422 :     CGI::td(CGI::password_field("add_initial_password", $add_initial_password, 25)),
423 :     ),
424 :     CGI::Tr(
425 :     CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
426 :     CGI::td(CGI::password_field("add_initial_confirmPassword", $add_initial_confirmPassword, 25)),
427 :     ),
428 :     ),
429 : gage 2299 ),
430 : sh002i 2378 CGI::td(
431 :     CGI::table({class=>"FormLayout"},
432 :     CGI::Tr(
433 :     CGI::th({class=>"LeftHeader"}, "First Name:"),
434 :     CGI::td(CGI::textfield("add_initial_firstName", $add_initial_firstName, 25)),
435 :     ),
436 :     CGI::Tr(
437 :     CGI::th({class=>"LeftHeader"}, "Last Name:"),
438 :     CGI::td(CGI::textfield("add_initial_lastName", $add_initial_lastName, 25)),
439 :     ),
440 :     CGI::Tr(
441 :     CGI::th({class=>"LeftHeader"}, "Email Address:"),
442 :     CGI::td(CGI::textfield("add_initial_email", $add_initial_email, 25)),
443 :     ),
444 :     ),
445 : gage 2242
446 :     ),
447 : sh002i 2378 ));
448 : gage 2254
449 : sh002i 2378 print CGI::p("To copy problem templates from an existing course, select the course below.");
450 : gage 2254
451 :     print CGI::table({class=>"FormLayout"},
452 :     CGI::Tr(
453 :     CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
454 :     CGI::td(
455 :     CGI::popup_menu(
456 :     -name => "add_templates_course",
457 :     -values => [ "", @existingCourses ],
458 :     -default => $add_templates_course,
459 :     #-size => 10,
460 :     #-multiple => 0,
461 :     #-labels => \%courseLabels,
462 :     ),
463 :    
464 :     ),
465 :     ),
466 :     );
467 :    
468 : sh002i 2378 print CGI::p("Select a database layout below.");
469 : sh002i 1960
470 :     foreach my $dbLayout (@dbLayouts) {
471 :     print CGI::start_table({class=>"FormLayout"});
472 :    
473 : sh002i 2639 my $dbLayoutLabel = (defined $DB_LAYOUT_DESCRIPTIONS{$dbLayout})
474 :     ? "$dbLayout - $DB_LAYOUT_DESCRIPTIONS{$dbLayout}"
475 :     : $dbLayout;
476 :    
477 : sh002i 1960 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
478 :     print CGI::Tr(
479 :     CGI::td({style=>"text-align: right"},
480 :     '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
481 :     . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
482 : sh002i 1945 ),
483 : sh002i 2639 CGI::td($dbLayoutLabel),
484 : sh002i 1945 );
485 :    
486 : sh002i 1960 print CGI::start_Tr();
487 :     print CGI::td(); # for indentation :(
488 :     print CGI::start_td();
489 : sh002i 1945
490 : sh002i 1960 if ($dbLayout eq "sql") {
491 : gage 2254 print CGI::start_table({class=>"FormLayout"});
492 :     print CGI::Tr(CGI::td({colspan=>2},
493 : sh002i 2378 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
494 : gage 2254 )
495 : sh002i 1960 );
496 : sh002i 1945 print CGI::Tr(
497 : gage 2254 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
498 :     CGI::td(CGI::textfield("add_sql_username", $add_sql_username, 25)),
499 :     );
500 :     print CGI::Tr(
501 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
502 :     CGI::td(CGI::password_field("add_sql_password", $add_sql_password, 25)),
503 :     );
504 :    
505 : sh002i 2378 print CGI::Tr(CGI::td({colspan=>2},
506 :     "The optionial SQL settings you enter below must match the settings in the DBI source"
507 :     . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
508 :     . " with the course name you entered above."
509 : gage 2254 )
510 :     );
511 :     print CGI::Tr(
512 : sh002i 1945 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
513 :     CGI::td(
514 : sh002i 1960 CGI::textfield("add_sql_host", $add_sql_host, 25),
515 : sh002i 1945 CGI::br(),
516 :     CGI::small("Leave blank to use the default host."),
517 :     ),
518 :     );
519 :     print CGI::Tr(
520 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
521 :     CGI::td(
522 : sh002i 1960 CGI::textfield("add_sql_port", $add_sql_port, 25),
523 : sh002i 1945 CGI::br(),
524 :     CGI::small("Leave blank to use the default port."),
525 :     ),
526 :     );
527 : gage 2254
528 : sh002i 1945 print CGI::Tr(
529 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
530 : sh002i 2104 CGI::td(
531 :     CGI::textfield("add_sql_database", $add_sql_database, 25),
532 :     CGI::br(),
533 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
534 :     ),
535 : sh002i 1945 );
536 :     print CGI::Tr(
537 :     CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
538 :     CGI::td(
539 : sh002i 1960 CGI::textfield("add_sql_wwhost", $add_sql_wwhost || "localhost", 25),
540 : sh002i 1945 CGI::br(),
541 :     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."),
542 :     ),
543 :     );
544 : sh002i 1960 print CGI::end_table();
545 :     } elsif ($dbLayout eq "gdbm") {
546 : sh002i 1945 print CGI::start_table({class=>"FormLayout"});
547 :     print CGI::Tr(
548 :     CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
549 : sh002i 2004 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)),
550 : sh002i 1945 );
551 : sh002i 1960 print CGI::end_table();
552 : sh002i 1945 }
553 :    
554 : sh002i 1960 print CGI::end_td();
555 :     print CGI::end_Tr();
556 : sh002i 1945 print CGI::end_table();
557 :     }
558 :    
559 : sh002i 1960 print CGI::p({style=>"text-align: center"}, CGI::submit("add_course", "Add Course"));
560 :    
561 :     print CGI::end_form();
562 :     }
563 :    
564 :     sub add_course_validate {
565 :     my ($self) = @_;
566 :     my $r = $self->r;
567 :     my $ce = $r->ce;
568 :     #my $db = $r->db;
569 :     #my $authz = $r->authz;
570 :     #my $urlpath = $r->urlpath;
571 :    
572 : gage 2254 my $add_courseID = $r->param("add_courseID") || "";
573 : sh002i 2378 my $add_courseTitle = $r->param("add_courseTitle") || "";
574 :     my $add_courseInstitution = $r->param("add_courseInstitution") || "";
575 :    
576 :     my $add_admin_users = $r->param("add_admin_users") || "";
577 :    
578 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
579 :     my $add_initial_password = $r->param("add_initial_password") || "";
580 :     my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || "";
581 :     my $add_initial_firstName = $r->param("add_initial_firstName") || "";
582 :     my $add_initial_lastName = $r->param("add_initial_lastName") || "";
583 :     my $add_initial_email = $r->param("add_initial_email") || "";
584 :    
585 :     my $add_templates_course = $r->param("add_templates_course") || "";
586 :    
587 : gage 2254 my $add_dbLayout = $r->param("add_dbLayout") || "";
588 :     my $add_sql_host = $r->param("add_sql_host") || "";
589 :     my $add_sql_port = $r->param("add_sql_port") || "";
590 :     my $add_sql_username = $r->param("add_sql_username") || "";
591 :     my $add_sql_password = $r->param("add_sql_password") || "";
592 :     my $add_sql_database = $r->param("add_sql_database") || "";
593 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
594 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
595 : sh002i 2378
596 : sh002i 1960 my @errors;
597 :    
598 :     if ($add_courseID eq "") {
599 : sh002i 2378 push @errors, "You must specify a course ID.";
600 : sh002i 1960 }
601 : sh002i 2887 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
602 :     push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
603 :     }
604 : sh002i 2373 if (grep { $add_courseID eq $_ } listCourses($ce)) {
605 : sh002i 2378 push @errors, "A course with ID $add_courseID already exists.";
606 : sh002i 2373 }
607 : sh002i 2378 if ($add_courseTitle eq "") {
608 :     push @errors, "You must specify a course title.";
609 : gage 2242 }
610 : sh002i 2378 if ($add_courseInstitution eq "") {
611 :     push @errors, "You must specify an institution for this course.";
612 : gage 2242 }
613 : sh002i 2378
614 :     if ($add_initial_userID ne "") {
615 :     if ($add_initial_password eq "") {
616 :     push @errors, "You must specify a password for the initial instructor.";
617 :     }
618 :     if ($add_initial_confirmPassword eq "") {
619 :     push @errors, "You must confirm the password for the initial instructor.";
620 :     }
621 :     if ($add_initial_password ne $add_initial_confirmPassword) {
622 :     push @errors, "The password and password confirmation for the instructor must match.";
623 :     }
624 :     if ($add_initial_firstName eq "") {
625 :     push @errors, "You must specify a first name for the initial instructor.";
626 :     }
627 :     if ($add_initial_lastName eq "") {
628 :     push @errors, "You must specify a last name for the initial instructor.";
629 :     }
630 :     if ($add_initial_email eq "") {
631 :     push @errors, "You must specify an email address for the initial instructor.";
632 :     }
633 : gage 2242 }
634 : sh002i 1960
635 :     if ($add_dbLayout eq "") {
636 :     push @errors, "You must select a database layout.";
637 :     } else {
638 :     if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
639 :     if ($add_dbLayout eq "sql") {
640 :     push @errors, "You must specify the SQL admin username." if $add_sql_username eq "";
641 :     push @errors, "You must specify the WeBWorK host." if $add_sql_wwhost eq "";
642 :     } elsif ($add_dbLayout eq "gdbm") {
643 :     push @errors, "You must specify the GDBM global user ID." if $add_gdbm_globalUserID eq "";
644 :     }
645 :     } else {
646 :     push @errors, "The database layout $add_dbLayout doesn't exist.";
647 :     }
648 :     }
649 :    
650 :     return @errors;
651 :     }
652 :    
653 :     sub do_add_course {
654 :     my ($self) = @_;
655 :     my $r = $self->r;
656 :     my $ce = $r->ce;
657 :     my $db = $r->db;
658 :     #my $authz = $r->authz;
659 :     my $urlpath = $r->urlpath;
660 :    
661 : sh002i 2378 my $add_courseID = $r->param("add_courseID") || "";
662 :     my $add_courseTitle = $r->param("add_courseTitle") || "";
663 :     my $add_courseInstitution = $r->param("add_courseInstitution") || "";
664 :    
665 :     my $add_admin_users = $r->param("add_admin_users") || "";
666 :    
667 :     my $add_initial_userID = $r->param("add_initial_userID") || "";
668 :     my $add_initial_password = $r->param("add_initial_password") || "";
669 :     my $add_initial_confirmPassword = $r->param("add_initial_confirmPassword") || "";
670 :     my $add_initial_firstName = $r->param("add_initial_firstName") || "";
671 :     my $add_initial_lastName = $r->param("add_initial_lastName") || "";
672 :     my $add_initial_email = $r->param("add_initial_email") || "";
673 :    
674 :     my $add_templates_course = $r->param("add_templates_course") || "";
675 :    
676 :     my $add_dbLayout = $r->param("add_dbLayout") || "";
677 :     my $add_sql_host = $r->param("add_sql_host") || "";
678 :     my $add_sql_port = $r->param("add_sql_port") || "";
679 :     my $add_sql_username = $r->param("add_sql_username") || "";
680 :     my $add_sql_password = $r->param("add_sql_password") || "";
681 :     my $add_sql_database = $r->param("add_sql_database") || "";
682 :     my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
683 :     my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
684 : gage 2242
685 : sh002i 1960 my $ce2 = WeBWorK::CourseEnvironment->new(
686 :     $ce->{webworkDirs}->{root},
687 :     $ce->{webworkURLs}->{root},
688 :     $ce->{pg}->{directories}->{root},
689 :     $add_courseID,
690 :     );
691 :    
692 : gage 2042 my %courseOptions = ( dbLayoutName => $add_dbLayout );
693 : sh002i 2384
694 :     if ($add_initial_email ne "") {
695 :     $courseOptions{allowedRecipients} = [ $add_initial_email ];
696 : sh002i 2853 # don't set feedbackRecipients -- this just gets in the way of the more
697 :     # intelligent "receive_recipients" method.
698 :     #$courseOptions{feedbackRecipients} = [ $add_initial_email ];
699 : sh002i 2384 }
700 :    
701 : sh002i 2004 if ($add_dbLayout eq "gdbm") {
702 :     $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
703 :     }
704 :    
705 : sh002i 1960 my %dbOptions;
706 :     if ($add_dbLayout eq "sql") {
707 :     $dbOptions{host} = $add_sql_host if $add_sql_host ne "";
708 :     $dbOptions{port} = $add_sql_port if $add_sql_port ne "";
709 :     $dbOptions{username} = $add_sql_username;
710 :     $dbOptions{password} = $add_sql_password;
711 : sh002i 2104 $dbOptions{database} = $add_sql_database || "webwork_$add_courseID";
712 : sh002i 1960 $dbOptions{wwhost} = $add_sql_wwhost;
713 :     }
714 : sh002i 2378
715 : sh002i 1960 my @users;
716 : sh002i 2378
717 :     # copy users from current (admin) course if desired
718 :     if ($add_admin_users ne "") {
719 :     foreach my $userID ($db->listUsers) {
720 : sh002i 2887 if ($userID eq $add_initial_userID) {
721 : gage 3284 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
722 : sh002i 2885 next;
723 :     }
724 : sh002i 2378 my $User = $db->getUser($userID);
725 :     my $Password = $db->getPassword($userID);
726 :     my $PermissionLevel = $db->getPermissionLevel($userID);
727 :     push @users, [ $User, $Password, $PermissionLevel ];
728 :     }
729 :     }
730 :    
731 :     # add initial instructor if desired
732 : sh002i 1960 if ($add_initial_userID ne "") {
733 : sh002i 2004 my $User = $db->newUser(
734 : sh002i 2384 user_id => $add_initial_userID,
735 :     first_name => $add_initial_firstName,
736 :     last_name => $add_initial_lastName,
737 :     student_id => $add_initial_userID,
738 :     email_address => $add_initial_email,
739 :     status => "C",
740 : sh002i 2004 );
741 :     my $Password = $db->newPassword(
742 : sh002i 2378 user_id => $add_initial_userID,
743 : sh002i 1960 password => cryptPassword($add_initial_password),
744 : sh002i 2004 );
745 :     my $PermissionLevel = $db->newPermissionLevel(
746 : sh002i 2378 user_id => $add_initial_userID,
747 : sh002i 1960 permission => "10",
748 : sh002i 2004 );
749 :     push @users, [ $User, $Password, $PermissionLevel ];
750 : sh002i 1960 }
751 : sh002i 2378
752 : dpvc 2704 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
753 : sh002i 2384
754 : sh002i 2148 my %optional_arguments;
755 :     if ($add_templates_course ne "") {
756 :     $optional_arguments{templatesFrom} = $add_templates_course;
757 :     }
758 :    
759 : sh002i 1960 eval {
760 :     addCourse(
761 : sh002i 2004 courseID => $add_courseID,
762 :     ce => $ce2,
763 :     courseOptions => \%courseOptions,
764 :     dbOptions => \%dbOptions,
765 :     users => \@users,
766 : sh002i 2148 %optional_arguments,
767 : sh002i 1945 );
768 : sh002i 1960 };
769 :     if ($@) {
770 :     my $error = $@;
771 :     print CGI::div({class=>"ResultsWithError"},
772 :     CGI::p("An error occured while creating the course $add_courseID:"),
773 :     CGI::tt(CGI::escapeHTML($error)),
774 :     );
775 : gage 2254 # get rid of any partially built courses
776 :     # FIXME -- this is too fragile
777 :     unless ($error =~ /course exists/) {
778 :     eval {
779 :     deleteCourse(
780 :     courseID => $add_courseID,
781 :     ce => $ce2,
782 :     dbOptions => \%dbOptions,
783 :     );
784 :     }
785 :     }
786 : sh002i 1960 } else {
787 : gage 2256 #log the action
788 : gage 2242 writeLog($ce, "hosted_courses", join("\t",
789 :     "\tAdded",
790 : sh002i 2378 $add_courseInstitution,
791 :     $add_courseTitle,
792 : gage 2242 $add_courseID,
793 : sh002i 2378 $add_initial_firstName,
794 :     $add_initial_lastName,
795 :     $add_initial_email,
796 : gage 2242 ));
797 : gage 2256 # add contact to admin course as student?
798 :     # FIXME -- should we do this?
799 : sh002i 1960 print CGI::div({class=>"ResultsWithoutError"},
800 :     CGI::p("Successfully created the course $add_courseID"),
801 :     );
802 :     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
803 :     courseID => $add_courseID);
804 :     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
805 :     print CGI::div({style=>"text-align: center"},
806 :     CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
807 :     );
808 :     }
809 : gage 2322
810 : gage 2299
811 : sh002i 1960 }
812 :    
813 :     ################################################################################
814 :    
815 : sh002i 3059 sub rename_course_form {
816 :     my ($self) = @_;
817 :     my $r = $self->r;
818 :     my $ce = $r->ce;
819 :     #my $db = $r->db;
820 :     #my $authz = $r->authz;
821 :     #my $urlpath = $r->urlpath;
822 :    
823 :     my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
824 :     my $rename_newCourseID = $r->param("rename_newCourseID") || "";
825 :    
826 :     my $rename_sql_host = $r->param("rename_sql_host") || "";
827 :     my $rename_sql_port = $r->param("rename_sql_port") || "";
828 :     my $rename_sql_username = $r->param("rename_sql_username") || "";
829 :     my $rename_sql_password = $r->param("rename_sql_password") || "";
830 :     my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
831 :     my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
832 :     my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
833 :    
834 :     my @courseIDs = listCourses($ce);
835 : gage 3434 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
836 : sh002i 3059
837 :     my %courseLabels; # records... heh.
838 :     foreach my $courseID (@courseIDs) {
839 :     my $tempCE = WeBWorK::CourseEnvironment->new(
840 :     $ce->{webworkDirs}->{root},
841 :     $ce->{webworkURLs}->{root},
842 :     $ce->{pg}->{directories}->{root},
843 :     $courseID,
844 :     );
845 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
846 :     }
847 :    
848 :     print CGI::h2("Rename Course");
849 :    
850 :     print CGI::start_form("POST", $r->uri);
851 :     print $self->hidden_authen_fields;
852 :     print $self->hidden_fields("subDisplay");
853 :    
854 :     print CGI::p("Select a course to rename.");
855 :    
856 :     print CGI::table({class=>"FormLayout"},
857 :     CGI::Tr(
858 :     CGI::th({class=>"LeftHeader"}, "Course Name:"),
859 :     CGI::td(
860 :     CGI::scrolling_list(
861 :     -name => "rename_oldCourseID",
862 :     -values => \@courseIDs,
863 :     -default => $rename_oldCourseID,
864 :     -size => 10,
865 :     -multiple => 0,
866 :     -labels => \%courseLabels,
867 :     ),
868 :     ),
869 :     ),
870 :     CGI::Tr(
871 :     CGI::th({class=>"LeftHeader"}, "New Name:"),
872 :     CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
873 :     ),
874 :     );
875 :    
876 :     print CGI::p(
877 :     "If the course's database layout (indicated in parentheses above) is "
878 :     . CGI::b("sql") . ", supply the SQL connections information requested below."
879 :     );
880 :    
881 :     print CGI::start_table({class=>"FormLayout"});
882 :     print CGI::Tr(CGI::td({colspan=>2},
883 :     "Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
884 :     )
885 :     );
886 :     print CGI::Tr(
887 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
888 :     CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
889 :     );
890 :     print CGI::Tr(
891 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
892 :     CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
893 :     );
894 :    
895 :     print CGI::Tr(
896 :     CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
897 :     CGI::td(
898 :     CGI::textfield("rename_sql_host", $rename_sql_host, 25),
899 :     CGI::br(),
900 :     CGI::small("Leave blank to use the default host."),
901 :     ),
902 :     );
903 :     print CGI::Tr(
904 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
905 :     CGI::td(
906 :     CGI::textfield("rename_sql_port", $rename_sql_port, 25),
907 :     CGI::br(),
908 :     CGI::small("Leave blank to use the default port."),
909 :     ),
910 :     );
911 :    
912 :     print CGI::Tr(
913 :     CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
914 :     CGI::td(
915 :     CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
916 :     CGI::br(),
917 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
918 :     ),
919 :     );
920 :     print CGI::Tr(
921 :     CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
922 :     CGI::td(
923 :     CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
924 :     CGI::br(),
925 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
926 :     ),
927 :     );
928 :     print CGI::Tr(
929 :     CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
930 :     CGI::td(
931 :     CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost || "localhost", 25),
932 :     CGI::br(),
933 :     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."),
934 :     ),
935 :     );
936 :     print CGI::end_table();
937 :    
938 :     print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
939 :    
940 :     print CGI::end_form();
941 :     }
942 :    
943 :     sub rename_course_validate {
944 :     my ($self) = @_;
945 :     my $r = $self->r;
946 :     my $ce = $r->ce;
947 :     #my $db = $r->db;
948 :     #my $authz = $r->authz;
949 :     #my $urlpath = $r->urlpath;
950 :    
951 :     my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
952 :     my $rename_newCourseID = $r->param("rename_newCourseID") || "";
953 :    
954 :     my $rename_sql_host = $r->param("rename_sql_host") || "";
955 :     my $rename_sql_port = $r->param("rename_sql_port") || "";
956 :     my $rename_sql_username = $r->param("rename_sql_username") || "";
957 :     my $rename_sql_password = $r->param("rename_sql_password") || "";
958 :     my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
959 :     my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
960 :     my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
961 :    
962 :     my @errors;
963 :    
964 :     if ($rename_oldCourseID eq "") {
965 :     push @errors, "You must select a course to rename.";
966 :     }
967 :     if ($rename_newCourseID eq "") {
968 :     push @errors, "You must specify a new name for the course.";
969 :     }
970 :     if ($rename_oldCourseID eq $rename_newCourseID) {
971 :     push @errors, "Can't rename to the same name.";
972 :     }
973 :     unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
974 :     push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
975 :     }
976 :     if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
977 :     push @errors, "A course with ID $rename_newCourseID already exists.";
978 :     }
979 :    
980 :     my $ce2 = WeBWorK::CourseEnvironment->new(
981 :     $ce->{webworkDirs}->{root},
982 :     $ce->{webworkURLs}->{root},
983 :     $ce->{pg}->{directories}->{root},
984 :     $rename_oldCourseID,
985 :     );
986 :    
987 :     if ($ce2->{dbLayoutName} eq "sql") {
988 :     push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
989 :     #push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
990 :     #push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
991 :     #push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
992 :     }
993 :    
994 :     return @errors;
995 :     }
996 :    
997 :     sub do_rename_course {
998 :     my ($self) = @_;
999 :     my $r = $self->r;
1000 :     my $ce = $r->ce;
1001 :     my $db = $r->db;
1002 :     #my $authz = $r->authz;
1003 :     my $urlpath = $r->urlpath;
1004 :    
1005 :     my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
1006 :     my $rename_newCourseID = $r->param("rename_newCourseID") || "";
1007 :    
1008 :     my $rename_sql_host = $r->param("rename_sql_host") || "";
1009 :     my $rename_sql_port = $r->param("rename_sql_port") || "";
1010 :     my $rename_sql_username = $r->param("rename_sql_username") || "";
1011 :     my $rename_sql_password = $r->param("rename_sql_password") || "";
1012 :     my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
1013 :     my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
1014 :     my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
1015 :    
1016 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1017 :     $ce->{webworkDirs}->{root},
1018 :     $ce->{webworkURLs}->{root},
1019 :     $ce->{pg}->{directories}->{root},
1020 :     $rename_oldCourseID,
1021 :     );
1022 :    
1023 :     my $dbLayoutName = $ce->{dbLayoutName};
1024 :    
1025 :     my %dbOptions;
1026 :     if ($dbLayoutName eq "sql") {
1027 :     $dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
1028 :     $dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
1029 :     $dbOptions{username} = $rename_sql_username;
1030 :     $dbOptions{password} = $rename_sql_password;
1031 :     $dbOptions{old_database} = $rename_sql_oldDatabase || "webwork_$rename_oldCourseID";
1032 :     $dbOptions{new_database} = $rename_sql_newDatabase || "webwork_$rename_newCourseID";
1033 :     $dbOptions{wwhost} = $rename_sql_wwhost;
1034 :     }
1035 :    
1036 :     eval {
1037 :     renameCourse(
1038 :     courseID => $rename_oldCourseID,
1039 :     ce => $ce2,
1040 :     dbOptions => \%dbOptions,
1041 :     newCourseID => $rename_newCourseID,
1042 :     );
1043 :     };
1044 :     if ($@) {
1045 :     my $error = $@;
1046 :     print CGI::div({class=>"ResultsWithError"},
1047 :     CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
1048 :     CGI::tt(CGI::escapeHTML($error)),
1049 :     );
1050 :     } else {
1051 :     print CGI::div({class=>"ResultsWithoutError"},
1052 :     CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
1053 :     );
1054 :     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
1055 :     courseID => $rename_newCourseID);
1056 :     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
1057 :     print CGI::div({style=>"text-align: center"},
1058 :     CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
1059 :     );
1060 :     }
1061 :     }
1062 :    
1063 :     ################################################################################
1064 :    
1065 : sh002i 1960 sub delete_course_form {
1066 :     my ($self) = @_;
1067 :     my $r = $self->r;
1068 :     my $ce = $r->ce;
1069 :     #my $db = $r->db;
1070 :     #my $authz = $r->authz;
1071 :     #my $urlpath = $r->urlpath;
1072 :    
1073 :     my $delete_courseID = $r->param("delete_courseID") || "";
1074 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
1075 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
1076 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
1077 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
1078 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
1079 :    
1080 :     my @courseIDs = listCourses($ce);
1081 : gage 3434 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1082 : sh002i 1960
1083 :     my %courseLabels; # records... heh.
1084 :     foreach my $courseID (@courseIDs) {
1085 :     my $tempCE = WeBWorK::CourseEnvironment->new(
1086 :     $ce->{webworkDirs}->{root},
1087 :     $ce->{webworkURLs}->{root},
1088 :     $ce->{pg}->{directories}->{root},
1089 :     $courseID,
1090 :     );
1091 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1092 :     }
1093 :    
1094 :     print CGI::h2("Delete Course");
1095 :    
1096 :     print CGI::start_form("POST", $r->uri);
1097 :     print $self->hidden_authen_fields;
1098 :     print $self->hidden_fields("subDisplay");
1099 :    
1100 :     print CGI::p("Select a course to delete.");
1101 :    
1102 :     print CGI::table({class=>"FormLayout"},
1103 :     CGI::Tr(
1104 :     CGI::th({class=>"LeftHeader"}, "Course Name:"),
1105 : sh002i 1945 CGI::td(
1106 : sh002i 1960 CGI::scrolling_list(
1107 :     -name => "delete_courseID",
1108 :     -values => \@courseIDs,
1109 :     -default => $delete_courseID,
1110 :     -size => 10,
1111 :     -multiple => 0,
1112 :     -labels => \%courseLabels,
1113 : sh002i 1945 ),
1114 :     ),
1115 : sh002i 1960 ),
1116 :     );
1117 :    
1118 :     print CGI::p(
1119 :     "If the course's database layout (indicated in parentheses above) is "
1120 :     . CGI::b("sql") . ", supply the SQL connections information requested below."
1121 :     );
1122 :    
1123 : sh002i 2719 print CGI::start_table({class=>"FormLayout"});
1124 :     print CGI::Tr(CGI::td({colspan=>2},
1125 :     "Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database."
1126 :     )
1127 :     );
1128 :     print CGI::Tr(
1129 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
1130 :     CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
1131 :     );
1132 :     print CGI::Tr(
1133 :     CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
1134 :     CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
1135 :     );
1136 : sh002i 1960
1137 : sh002i 2719 #print CGI::Tr(CGI::td({colspan=>2},
1138 :     # "The optionial SQL settings you enter below must match the settings in the DBI source"
1139 :     # . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
1140 :     # . " with the course name you entered above."
1141 :     # )
1142 :     #);
1143 :     print CGI::Tr(
1144 :     CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
1145 :     CGI::td(
1146 :     CGI::textfield("delete_sql_host", $delete_sql_host, 25),
1147 :     CGI::br(),
1148 :     CGI::small("Leave blank to use the default host."),
1149 :     ),
1150 :     );
1151 :     print CGI::Tr(
1152 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
1153 :     CGI::td(
1154 :     CGI::textfield("delete_sql_port", $delete_sql_port, 25),
1155 :     CGI::br(),
1156 :     CGI::small("Leave blank to use the default port."),
1157 :     ),
1158 :     );
1159 :    
1160 :     print CGI::Tr(
1161 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
1162 :     CGI::td(
1163 :     CGI::textfield("delete_sql_database", $delete_sql_database, 25),
1164 :     CGI::br(),
1165 :     CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
1166 :     ),
1167 :     );
1168 :     print CGI::end_table();
1169 :    
1170 : sh002i 1960 print CGI::p({style=>"text-align: center"}, CGI::submit("delete_course", "Delete Course"));
1171 :    
1172 :     print CGI::end_form();
1173 :     }
1174 :    
1175 :     sub delete_course_validate {
1176 :     my ($self) = @_;
1177 :     my $r = $self->r;
1178 :     my $ce = $r->ce;
1179 :     #my $db = $r->db;
1180 :     #my $authz = $r->authz;
1181 :     my $urlpath = $r->urlpath;
1182 :    
1183 :     my $delete_courseID = $r->param("delete_courseID") || "";
1184 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
1185 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
1186 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
1187 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
1188 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
1189 :    
1190 :     my @errors;
1191 :    
1192 :     if ($delete_courseID eq "") {
1193 :     push @errors, "You must specify a course name.";
1194 :     } elsif ($delete_courseID eq $urlpath->arg("courseID")) {
1195 :     push @errors, "You cannot delete the course you are currently using.";
1196 :     }
1197 :    
1198 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1199 :     $ce->{webworkDirs}->{root},
1200 :     $ce->{webworkURLs}->{root},
1201 :     $ce->{pg}->{directories}->{root},
1202 :     $delete_courseID,
1203 :     );
1204 :    
1205 :     if ($ce2->{dbLayoutName} eq "sql") {
1206 :     push @errors, "You must specify the SQL admin username." if $delete_sql_username eq "";
1207 : sh002i 2189 #push @errors, "You must specify the SQL admin password." if $delete_sql_password eq "";
1208 :     #push @errors, "You must specify the SQL database name." if $delete_sql_database eq "";
1209 : sh002i 1960 }
1210 :    
1211 :     return @errors;
1212 :     }
1213 :    
1214 :     sub delete_course_confirm {
1215 :     my ($self) = @_;
1216 :     my $r = $self->r;
1217 :     my $ce = $r->ce;
1218 :     #my $db = $r->db;
1219 :     #my $authz = $r->authz;
1220 :     #my $urlpath = $r->urlpath;
1221 :    
1222 :     print CGI::h2("Delete Course");
1223 :    
1224 :     my $delete_courseID = $r->param("delete_courseID") || "";
1225 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
1226 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
1227 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
1228 :    
1229 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1230 :     $ce->{webworkDirs}->{root},
1231 :     $ce->{webworkURLs}->{root},
1232 :     $ce->{pg}->{directories}->{root},
1233 :     $delete_courseID,
1234 :     );
1235 :    
1236 :     if ($ce2->{dbLayoutName} eq "sql") {
1237 :     print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
1238 :     . "? All course files and data and the following database will be destroyed."
1239 :     . " There is no undo available.");
1240 :    
1241 :     print CGI::table({class=>"FormLayout"},
1242 :     CGI::Tr(
1243 :     CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
1244 :     CGI::td($delete_sql_host || "system default"),
1245 : sh002i 1945 ),
1246 : sh002i 1960 CGI::Tr(
1247 :     CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
1248 :     CGI::td($delete_sql_port || "system default"),
1249 :     ),
1250 :     CGI::Tr(
1251 :     CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
1252 : sh002i 2189 CGI::td($delete_sql_database || "webwork_$delete_courseID"),
1253 : sh002i 1960 ),
1254 : sh002i 1945 );
1255 : sh002i 1960 } else {
1256 :     print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
1257 :     . "? All course files and data will be destroyed. There is no undo available.");
1258 : sh002i 1945 }
1259 :    
1260 : sh002i 1960 print CGI::start_form("POST", $r->uri);
1261 :     print $self->hidden_authen_fields;
1262 :     print $self->hidden_fields("subDisplay");
1263 :     print $self->hidden_fields(qw/delete_courseID delete_sql_host delete_sql_port delete_sql_username delete_sql_password delete_sql_database/);
1264 :    
1265 :     print CGI::p({style=>"text-align: center"},
1266 :     CGI::submit("decline_delete_course", "Don't delete"),
1267 :     "&nbsp;",
1268 :     CGI::submit("confirm_delete_course", "Delete"),
1269 :     );
1270 :    
1271 :     print CGI::end_form();
1272 :     }
1273 :    
1274 :     sub do_delete_course {
1275 :     my ($self) = @_;
1276 :     my $r = $self->r;
1277 :     my $ce = $r->ce;
1278 :     #my $db = $r->db;
1279 :     #my $authz = $r->authz;
1280 :     #my $urlpath = $r->urlpath;
1281 :    
1282 :     my $delete_courseID = $r->param("delete_courseID") || "";
1283 :     my $delete_sql_host = $r->param("delete_sql_host") || "";
1284 :     my $delete_sql_port = $r->param("delete_sql_port") || "";
1285 :     my $delete_sql_username = $r->param("delete_sql_username") || "";
1286 :     my $delete_sql_password = $r->param("delete_sql_password") || "";
1287 :     my $delete_sql_database = $r->param("delete_sql_database") || "";
1288 :    
1289 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1290 :     $ce->{webworkDirs}->{root},
1291 :     $ce->{webworkURLs}->{root},
1292 :     $ce->{pg}->{directories}->{root},
1293 :     $delete_courseID,
1294 :     );
1295 :    
1296 :     my %dbOptions;
1297 :     if ($ce2->{dbLayoutName} eq "sql") {
1298 :     $dbOptions{host} = $delete_sql_host if $delete_sql_host ne "";
1299 :     $dbOptions{port} = $delete_sql_port if $delete_sql_port ne "";
1300 :     $dbOptions{username} = $delete_sql_username;
1301 :     $dbOptions{password} = $delete_sql_password;
1302 : sh002i 2189 $dbOptions{database} = $delete_sql_database || "webwork_$delete_courseID";
1303 : sh002i 1960 }
1304 :    
1305 :     eval {
1306 :     deleteCourse(
1307 :     courseID => $delete_courseID,
1308 :     ce => $ce2,
1309 :     dbOptions => \%dbOptions,
1310 :     );
1311 :     };
1312 :    
1313 :     if ($@) {
1314 :     my $error = $@;
1315 :     print CGI::div({class=>"ResultsWithError"},
1316 :     CGI::p("An error occured while deleting the course $delete_courseID:"),
1317 :     CGI::tt(CGI::escapeHTML($error)),
1318 :     );
1319 :     } else {
1320 :     print CGI::div({class=>"ResultsWithoutError"},
1321 : sh002i 2378 CGI::p("Successfully deleted the course $delete_courseID."),
1322 : sh002i 1960 );
1323 : gage 2242 writeLog($ce, "hosted_courses", join("\t",
1324 :     "\tDeleted",
1325 :     "",
1326 :     "",
1327 :     $delete_courseID,
1328 :     ));
1329 : sh002i 1945 print CGI::start_form("POST", $r->uri);
1330 :     print $self->hidden_authen_fields;
1331 : sh002i 1960 print $self->hidden_fields("subDisplay");
1332 : sh002i 1945
1333 : sh002i 1960 print CGI::p({style=>"text-align: center"}, CGI::submit("decline_delete_course", "OK"),);
1334 : sh002i 1945
1335 : sh002i 1960 print CGI::end_form();
1336 : sh002i 1945 }
1337 :     }
1338 :    
1339 : sh002i 1985 ################################################################################
1340 :    
1341 :     sub export_database_form {
1342 :     my ($self) = @_;
1343 :     my $r = $self->r;
1344 :     my $ce = $r->ce;
1345 :     #my $db = $r->db;
1346 :     #my $authz = $r->authz;
1347 :     #my $urlpath = $r->urlpath;
1348 :    
1349 :     my @tables = keys %{$ce->{dbLayout}};
1350 :    
1351 :     my $export_courseID = $r->param("export_courseID") || "";
1352 :     my @export_tables = $r->param("export_tables");
1353 : gage 3235
1354 : sh002i 1985 @export_tables = @tables unless @export_tables;
1355 :    
1356 :     my @courseIDs = listCourses($ce);
1357 : gage 3434 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1358 : sh002i 1985
1359 :     my %courseLabels; # records... heh.
1360 :     foreach my $courseID (@courseIDs) {
1361 :     my $tempCE = WeBWorK::CourseEnvironment->new(
1362 :     $ce->{webworkDirs}->{root},
1363 :     $ce->{webworkURLs}->{root},
1364 :     $ce->{pg}->{directories}->{root},
1365 :     $courseID,
1366 :     );
1367 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1368 :     }
1369 :    
1370 :     print CGI::h2("Export Database");
1371 :    
1372 : sh002i 2478 print CGI::start_form("GET", $r->uri);
1373 : sh002i 1985 print $self->hidden_authen_fields;
1374 :     print $self->hidden_fields("subDisplay");
1375 :    
1376 : sh002i 2844 print CGI::p("Select a course to export the course's database. Please note
1377 :     that exporting can take a very long time for a large course. If you have
1378 :     shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
1379 :     utility instead.");
1380 : sh002i 1985
1381 :     print CGI::table({class=>"FormLayout"},
1382 :     CGI::Tr(
1383 :     CGI::th({class=>"LeftHeader"}, "Course Name:"),
1384 :     CGI::td(
1385 :     CGI::scrolling_list(
1386 :     -name => "export_courseID",
1387 :     -values => \@courseIDs,
1388 :     -default => $export_courseID,
1389 :     -size => 10,
1390 : gage 3235 -multiple => 1,
1391 : sh002i 1985 -labels => \%courseLabels,
1392 :     ),
1393 :     ),
1394 :     ),
1395 :     CGI::Tr(
1396 :     CGI::th({class=>"LeftHeader"}, "Tables to Export:"),
1397 :     CGI::td(
1398 :     CGI::checkbox_group(
1399 :     -name => "export_tables",
1400 :     -values => \@tables,
1401 :     -default => \@export_tables,
1402 :     -linebreak => 1,
1403 :     ),
1404 :     ),
1405 :     ),
1406 :     );
1407 :    
1408 :     print CGI::p({style=>"text-align: center"}, CGI::submit("export_database", "Export Database"));
1409 :    
1410 :     print CGI::end_form();
1411 :     }
1412 :    
1413 :     sub export_database_validate {
1414 :     my ($self) = @_;
1415 :     my $r = $self->r;
1416 :     #my $ce = $r->ce;
1417 :     #my $db = $r->db;
1418 :     #my $authz = $r->authz;
1419 :     #my $urlpath = $r->urlpath;
1420 :    
1421 : gage 3235 my @export_courseID = $r->param("export_courseID") || ();
1422 : sh002i 1985 my @export_tables = $r->param("export_tables");
1423 : gage 3235
1424 : sh002i 1985 my @errors;
1425 : gage 3235
1426 :     unless ( @export_courseID) {
1427 :     push @errors, "You must specify at least one course name.";
1428 : sh002i 1985 }
1429 :    
1430 :     unless (@export_tables) {
1431 :     push @errors, "You must specify at least one table to export.";
1432 :     }
1433 :    
1434 :     return @errors;
1435 :     }
1436 :    
1437 :     sub do_export_database {
1438 :     my ($self) = @_;
1439 :     my $r = $self->r;
1440 :     my $ce = $r->ce;
1441 :     #my $db = $r->db;
1442 :     #my $authz = $r->authz;
1443 :     my $urlpath = $r->urlpath;
1444 :    
1445 : gage 3235 my @export_courseID = $r->param("export_courseID");
1446 : sh002i 1985 my @export_tables = $r->param("export_tables");
1447 :    
1448 : gage 3235 foreach my $export_courseID (@export_courseID) {
1449 :    
1450 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1451 :     $ce->{webworkDirs}->{root},
1452 :     $ce->{webworkURLs}->{root},
1453 :     $ce->{pg}->{directories}->{root},
1454 :     $export_courseID,
1455 :     );
1456 :    
1457 :     my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1458 :    
1459 :     #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1460 :     #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1461 :     # export to the admin/templates directory
1462 :     my $exportFileName = "$export_courseID.exported.xml";
1463 :     my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
1464 :     # get a unique name
1465 :     my $number =1;
1466 :     while (-e "$exportFilePath.$number.gz") {
1467 :     $number++;
1468 :     last if $number>9;
1469 :     }
1470 :     if ($number<=9 ) {
1471 :     $exportFilePath = "$exportFilePath.$number";
1472 :     $exportFileName = "$exportFileName.$number";
1473 :     } else {
1474 :     $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
1475 :     remove some of these files."));
1476 :     $exportFilePath = "$exportFilePath.999";
1477 :     $exportFileName = "$exportFileName.999";
1478 :     }
1479 : sh002i 1985
1480 : gage 3235 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1481 : sh002i 1985
1482 : gage 3235 my @errors;
1483 :     eval {
1484 :     @errors = dbExport(
1485 :     db => $db2,
1486 :     #xml => $fh,
1487 :     xml => $outputFileHandle,
1488 :     tables => \@export_tables,
1489 :     );
1490 :     };
1491 :    
1492 :     $outputFileHandle->close();
1493 : sh002i 1985
1494 : gage 3235 my $gzipMessage = system( 'gzip', $exportFilePath);
1495 :     if ( !$gzipMessage ) {
1496 :     $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
1497 :     You may download it with the file manager."));
1498 :     } else {
1499 :     $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
1500 :     }
1501 :     unlink $exportFilePath;
1502 :     } # end export of one course
1503 : sh002i 2478 #push @errors, "Fatal exception: $@" if $@;
1504 :     #
1505 :     #if (@errors) {
1506 :     # print CGI::div({class=>"ResultsWithError"},
1507 :     # CGI::p("An error occured while exporting the database of course $export_courseID:"),
1508 :     # CGI::ul(CGI::li(\@errors)),
1509 :     # );
1510 :     #} else {
1511 :     # print CGI::div({class=>"ResultsWithoutError"},
1512 :     # CGI::p("Export succeeded."),
1513 :     # );
1514 :     #
1515 :     # print CGI::div({style=>"text-align: center"},
1516 :     # CGI::a({href=>$self->systemLink($urlpath, params=>{download_exported_database=>$random_chars, export_courseID=>undef})}, "Download Exported Database"),
1517 :     # );
1518 :     #}
1519 : sh002i 1985 }
1520 :    
1521 :     ################################################################################
1522 :    
1523 :     sub import_database_form {
1524 :     my ($self) = @_;
1525 :     my $r = $self->r;
1526 :     my $ce = $r->ce;
1527 :     #my $db = $r->db;
1528 :     #my $authz = $r->authz;
1529 :     #my $urlpath = $r->urlpath;
1530 :    
1531 :     my @tables = keys %{$ce->{dbLayout}};
1532 :    
1533 :     my $import_file = $r->param("import_file") || "";
1534 :     my $import_courseID = $r->param("import_courseID") || "";
1535 :     my @import_tables = $r->param("import_tables");
1536 :     my $import_conflict = $r->param("import_conflict") || "skip";
1537 :    
1538 :     @import_tables = @tables unless @import_tables;
1539 :    
1540 :     my @courseIDs = listCourses($ce);
1541 : gage 3434 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1542 : gage 2045
1543 : sh002i 1985
1544 :     my %courseLabels; # records... heh.
1545 :     foreach my $courseID (@courseIDs) {
1546 :     my $tempCE = WeBWorK::CourseEnvironment->new(
1547 :     $ce->{webworkDirs}->{root},
1548 :     $ce->{webworkURLs}->{root},
1549 :     $ce->{pg}->{directories}->{root},
1550 :     $courseID,
1551 :     );
1552 :     $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1553 :     }
1554 :    
1555 : gage 3235 # find databases:
1556 :     my $templatesDir = $ce->{courseDirs}->{templates};
1557 :     my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
1558 :     my $exempt_dirs = join("|", keys %probLibs);
1559 :    
1560 :     my @databaseFiles = listFilesRecursive(
1561 :     $templatesDir,
1562 :     qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
1563 :     qr/^(?:$exempt_dirs|CVS)$/, # prune these directories
1564 :     0, # match against file name only
1565 :     1, # prune against path relative to $templatesDir
1566 :     );
1567 :    
1568 :     my %databaseLabels = map { ($_ => $_) } @databaseFiles;
1569 :    
1570 :     #######
1571 :    
1572 : sh002i 1985 print CGI::h2("Import Database");
1573 :    
1574 :     print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1575 :     print $self->hidden_authen_fields;
1576 :     print $self->hidden_fields("subDisplay");
1577 :    
1578 :     print CGI::table({class=>"FormLayout"},
1579 :     CGI::Tr(
1580 :     CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1581 : gage 3235 # CGI::td(
1582 :     # CGI::filefield(
1583 :     # -name => "import_file",
1584 :     # -size => 50,
1585 :     # ),
1586 :     # ),
1587 : sh002i 1985 CGI::td(
1588 : gage 3235 CGI::scrolling_list(
1589 : sh002i 1985 -name => "import_file",
1590 : gage 3235 -values => \@databaseFiles,
1591 :     -default => undef,
1592 :     -size => 10,
1593 :     -multiple => 0,
1594 :     -labels => \%databaseLabels,
1595 : sh002i 1985 ),
1596 : gage 3235
1597 :     )
1598 : sh002i 1985 ),
1599 :     CGI::Tr(
1600 :     CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1601 :     CGI::td(
1602 :     CGI::checkbox_group(
1603 :     -name => "import_tables",
1604 :     -values => \@tables,
1605 :     -default => \@import_tables,
1606 :     -linebreak => 1,
1607 :     ),
1608 :     ),
1609 :     ),
1610 :     CGI::Tr(
1611 :     CGI::th({class=>"LeftHeader"}, "Import into Course:"),
1612 :     CGI::td(
1613 :     CGI::scrolling_list(
1614 :     -name => "import_courseID",
1615 :     -values => \@courseIDs,
1616 :     -default => $import_courseID,
1617 :     -size => 10,
1618 :     -multiple => 0,
1619 :     -labels => \%courseLabels,
1620 :     ),
1621 :     ),
1622 :     ),
1623 :     CGI::Tr(
1624 :     CGI::th({class=>"LeftHeader"}, "Conflicts:"),
1625 :     CGI::td(
1626 :     CGI::radio_group(
1627 :     -name => "import_conflict",
1628 :     -values => [qw/skip replace/],
1629 :     -default => $import_conflict,
1630 :     -linebreak=>'true',
1631 :     -labels => {
1632 :     skip => "Skip duplicate records",
1633 :     replace => "Replace duplicate records",
1634 :     },
1635 :     ),
1636 :     ),
1637 :     ),
1638 :     );
1639 :    
1640 :     print CGI::p({style=>"text-align: center"}, CGI::submit("import_database", "Import Database"));
1641 :    
1642 :     print CGI::end_form();
1643 :     }
1644 :    
1645 :     sub import_database_validate {
1646 :     my ($self) = @_;
1647 :     my $r = $self->r;
1648 :     #my $ce = $r->ce;
1649 :     #my $db = $r->db;
1650 :     #my $authz = $r->authz;
1651 :     #my $urlpath = $r->urlpath;
1652 :    
1653 :     my $import_file = $r->param("import_file") || "";
1654 :     my $import_courseID = $r->param("import_courseID") || "";
1655 :     my @import_tables = $r->param("import_tables");
1656 :     #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked
1657 :    
1658 :     my @errors;
1659 :    
1660 :     if ($import_file eq "") {
1661 : gage 3235 push @errors, "You must specify a database file to import.";
1662 : sh002i 1985 }
1663 :    
1664 :     if ($import_courseID eq "") {
1665 :     push @errors, "You must specify a course name.";
1666 :     }
1667 :    
1668 :     unless (@import_tables) {
1669 :     push @errors, "You must specify at least one table to import.";
1670 :     }
1671 :    
1672 :     return @errors;
1673 :     }
1674 :    
1675 :     sub do_import_database {
1676 :     my ($self) = @_;
1677 :     my $r = $self->r;
1678 :     my $ce = $r->ce;
1679 :     #my $db = $r->db;
1680 :     #my $authz = $r->authz;
1681 :     my $urlpath = $r->urlpath;
1682 :    
1683 :     my $import_file = $r->param("import_file");
1684 :     my $import_courseID = $r->param("import_courseID");
1685 :     my @import_tables = $r->param("import_tables");
1686 :     my $import_conflict = $r->param("import_conflict") || "skip"; # need default -- not checked above
1687 :    
1688 :     my $ce2 = WeBWorK::CourseEnvironment->new(
1689 :     $ce->{webworkDirs}->{root},
1690 :     $ce->{webworkURLs}->{root},
1691 :     $ce->{pg}->{directories}->{root},
1692 :     $import_courseID,
1693 :     );
1694 :    
1695 :     my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1696 :    
1697 : gage 3235 # locate file
1698 :     my $templateDir = $ce->{courseDirs}->{templates};
1699 :     my $filePath = "$templateDir/$import_file";
1700 :    
1701 :     my $gunzipMessage = system( 'gunzip', $filePath);
1702 :     #FIXME
1703 :     #warn "gunzip ", $gunzipMessage;
1704 :     $filePath =~ s/\.gz$//;
1705 :     #warn "new file path is $filePath";
1706 :     my $fileHandle = new IO::File("<$filePath");
1707 : sh002i 1985 # retrieve upload from upload cache
1708 : gage 3235 # my ($id, $hash) = split /\s+/, $import_file;
1709 :     # my $upload = WeBWorK::Upload->retrieve($id, $hash,
1710 :     # dir => $ce->{webworkDirs}->{uploadCache}
1711 :     # );
1712 : sh002i 1985
1713 :     my @errors;
1714 :    
1715 :     eval {
1716 :     @errors = dbImport(
1717 :     db => $db2,
1718 : gage 3235 # xml => $upload->fileHandle,
1719 :     xml => $fileHandle,
1720 : sh002i 1985 tables => \@import_tables,
1721 :     conflict => $import_conflict,
1722 :     );
1723 :     };
1724 :    
1725 :     push @errors, "Fatal exception: $@" if $@;
1726 : gage 3235 push @errors, $gunzipMessage if $gunzipMessage;
1727 : sh002i 1985
1728 :     if (@errors) {
1729 :     print CGI::div({class=>"ResultsWithError"},
1730 :     CGI::p("An error occured while importing the database of course $import_courseID:"),
1731 :     CGI::ul(CGI::li(\@errors)),
1732 :     );
1733 :     } else {
1734 :     print CGI::div({class=>"ResultsWithoutError"},
1735 :     CGI::p("Import succeeded."),
1736 :     );
1737 :     }
1738 :     }
1739 :    
1740 : sh002i 1945 1;
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9