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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2479 Revision 3437
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.23 2004/07/10 16:06:59 sh002i Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.36 2005/07/14 13:15:25 glarose Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
27use warnings; 27use warnings;
28use CGI::Pretty qw(); 28use CGI::Pretty qw();
29use Data::Dumper; 29use Data::Dumper;
30use File::Temp qw/tempfile/; 30use File::Temp qw/tempfile/;
31use WeBWorK::CourseEnvironment; 31use WeBWorK::CourseEnvironment;
32use IO::File;
32use WeBWorK::Utils qw(cryptPassword writeLog); 33use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive);
33use WeBWorK::Utils::CourseManagement qw(addCourse deleteCourse listCourses); 34use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses);
34use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); 35use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
36
37# put the following database layouts at the top of the list, in this order
38our @DB_LAYOUT_ORDER = qw/sql_single gdbm sql/;
39
40our %DB_LAYOUT_DESCRIPTIONS = (
41 gdbm => CGI::i("Deprecated. Uses GDBM databases to record WeBWorK data. Use this layout if the course must be used with WeBWorK 1.x."),
42 sql => CGI::i("Deprecated. Uses a separate SQL database to record WeBWorK data for each course."),
43 sql_single => "Uses a single SQL database to record WeBWorK data for all courses using this layout. This is the recommended layout for new courses.",
44);
35 45
36sub pre_header_initialize { 46sub pre_header_initialize {
37 my ($self) = @_; 47 my ($self) = @_;
38 my $r = $self->r; 48 my $r = $self->r;
39 my $ce = $r->ce; 49 my $ce = $r->ce;
… …
46 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 56 unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
47 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") ); 57 $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
48 return; 58 return;
49 } 59 }
50 60
61 # get result and send to message
62 my $status_message = $r->param("status_message");
63 $self->addmessage(CGI::p("$status_message")) if $status_message;
64
51 ## if the user is asking for the downloaded database... 65 ## if the user is asking for the downloaded database...
52 #if (defined $r->param("download_exported_database")) { 66 #if (defined $r->param("download_exported_database")) {
53 # my $courseID = $r->param("export_courseID"); 67 # my $courseID = $r->param("export_courseID");
54 # my $random_chars = $r->param("download_exported_database"); 68 # my $random_chars = $r->param("download_exported_database");
55 # 69 #
… …
80 } else { 94 } else {
81 $method_to_call = "do_add_course"; 95 $method_to_call = "do_add_course";
82 } 96 }
83 } else { 97 } else {
84 $method_to_call = "add_course_form"; 98 $method_to_call = "add_course_form";
99 }
100 }
101
102 elsif ($subDisplay eq "rename_course") {
103 if (defined $r->param("rename_course")) {
104 @errors = $self->rename_course_validate;
105 if (@errors) {
106 $method_to_call = "rename_course_form";
107 } else {
108 $method_to_call = "do_rename_course";
109 }
110 } else {
111 $method_to_call = "rename_course_form";
85 } 112 }
86 } 113 }
87 114
88 elsif ($subDisplay eq "delete_course") { 115 elsif ($subDisplay eq "delete_course") {
89 if (defined $r->param("delete_course")) { 116 if (defined $r->param("delete_course")) {
… …
149} 176}
150 177
151sub header { 178sub header {
152 my ($self) = @_; 179 my ($self) = @_;
153 my $method_to_call = $self->{method_to_call}; 180 my $method_to_call = $self->{method_to_call};
154 if (defined $method_to_call and $method_to_call eq "do_export_database") { 181# if (defined $method_to_call and $method_to_call eq "do_export_database") {
155 my $r = $self->r; 182# my $r = $self->r;
156 my $courseID = $r->param("export_courseID"); 183# my $courseID = $r->param("export_courseID");
157 $r->content_type("application/octet-stream"); 184# $r->content_type("application/octet-stream");
158 $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 185# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
159 $r->send_http_header; 186# $r->send_http_header;
160 } else { 187# } else {
161 $self->SUPER::header; 188 $self->SUPER::header;
162 } 189# }
163} 190}
164 191
165# sends: 192# sends:
166# 193#
167# HTTP/1.1 200 OK 194# HTTP/1.1 200 OK
… …
173 200
174sub content { 201sub content {
175 my ($self) = @_; 202 my ($self) = @_;
176 my $method_to_call = $self->{method_to_call}; 203 my $method_to_call = $self->{method_to_call};
177 if (defined $method_to_call and $method_to_call eq "do_export_database") { 204 if (defined $method_to_call and $method_to_call eq "do_export_database") {
178 print "<!-- Ϸĩ½ōú -->\n";
179 print "<!-- Those were some high-bit characters to convince Safari that we really do want this saved as a file. -->\n";
180 $self->do_export_database; 205 #$self->do_export_database;
206 $self->SUPER::content;
181 } else { 207 } else {
182 $self->SUPER::content; 208 $self->SUPER::content;
183 } 209 }
184} 210}
185 211
… …
195 221
196 # check permissions 222 # check permissions
197 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 223 unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
198 return ""; 224 return "";
199 } 225 }
226 my $method_to_call = $self->{method_to_call};
227 my $methodMessage ="";
228
229 (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
200 239
201 print CGI::p({style=>"text-align: center"}, 240 print CGI::p({style=>"text-align: center"},
241 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
242 add_dbLayout=>'sql_single',
243 add_templates_course => $ce->{siteDefaults}->{default_templates_course} ||""}
244 )},
245 "Add Course"
246 ),
247 " | ",
202 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 248 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
203 " | ", 249 " | ",
204 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 250 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
205 " | ", 251 " | ",
206 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 252 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
207 " | ", 253 " | ",
208 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 254 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
255 CGI::hr(),
256 $methodMessage,
257
209 ); 258 );
210 259
211 print CGI::hr(); 260 print CGI::p("The ability to import and to export databases is still under development.
261 It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
262 use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
263 Please send bug reports if you find errors. ");
212 264
213 my @errors = @{$self->{errors}}; 265 my @errors = @{$self->{errors}};
214 my $method_to_call = $self->{method_to_call}; 266
215 267
216 if (@errors) { 268 if (@errors) {
217 print CGI::div({class=>"ResultsWithError"}, 269 print CGI::div({class=>"ResultsWithError"},
218 CGI::p("Please correct the following errors and try again:"), 270 CGI::p("Please correct the following errors and try again:"),
219 CGI::ul(CGI::li(\@errors)), 271 CGI::ul(CGI::li(\@errors)),
220 ); 272 );
221 } 273 }
222 274
223 if (defined $method_to_call and $method_to_call ne "") { 275 if (defined $method_to_call and $method_to_call ne "") {
224 $self->$method_to_call; 276 $self->$method_to_call;
277 } else {
278
279 print CGI::h2("Courses");
280
281 print CGI::start_ol();
282
283 my @courseIDs = listCourses($ce);
284 foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
285 next if $courseID eq "admin"; # done already above
286 my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", courseID => $courseID);
287 my $tempCE = WeBWorK::CourseEnvironment->new(
288 $ce->{webworkDirs}->{root},
289 $ce->{webworkURLs}->{root},
290 $ce->{pg}->{directories}->{root},
291 $courseID,
292 );
293 print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
294 CGI::code(
295 $tempCE->{dbLayoutName},
296 ),
297 (-r $tempCE->{courseFiles}->{environment}) ? "" : CGI::i(", missing course.conf"),
298
299 );
300
225 } 301 }
226 302
303 print CGI::end_ol();
304 }
227 return ""; 305 return "";
228} 306}
229 307
230################################################################################ 308################################################################################
231 309
… …
259 my $add_sql_password = $r->param("add_sql_password") || ""; 337 my $add_sql_password = $r->param("add_sql_password") || "";
260 my $add_sql_database = $r->param("add_sql_database") || ""; 338 my $add_sql_database = $r->param("add_sql_database") || "";
261 my $add_sql_wwhost = $r->param("add_sql_wwhost") || ""; 339 my $add_sql_wwhost = $r->param("add_sql_wwhost") || "";
262 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || ""; 340 my $add_gdbm_globalUserID = $r->param("add_gdbm_globalUserID") || "";
263 341
264 my @dbLayouts = sort keys %{ $ce->{dbLayouts} }; 342 my @dbLayouts = do {
343 my @ordered_layouts;
344 foreach my $layout (@DB_LAYOUT_ORDER) {
345 if (exists $ce->{dbLayouts}->{$layout}) {
346 push @ordered_layouts, $layout;
347 }
348 }
349
350 my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
351 my @other_layouts;
352 foreach my $layout (keys %{ $ce->{dbLayouts} }) {
353 unless (exists $ordered_layouts{$layout}) {
354 push @other_layouts, $layout;
355 }
356 }
357
358 (@ordered_layouts, @other_layouts);
359 };
265 360
266 my $ce2 = WeBWorK::CourseEnvironment->new( 361 my $ce2 = WeBWorK::CourseEnvironment->new(
267 $ce->{webworkDirs}->{root}, 362 $ce->{webworkDirs}->{root},
268 $ce->{webworkURLs}->{root}, 363 $ce->{webworkURLs}->{root},
269 $ce->{pg}->{directories}->{root}, 364 $ce->{pg}->{directories}->{root},
… …
287 } 382 }
288 $source; 383 $source;
289 }; 384 };
290 385
291 my @existingCourses = listCourses($ce); 386 my @existingCourses = listCourses($ce);
292 @existingCourses = sort @existingCourses; 387 @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
293 388
294 print CGI::h2("Add Course"); 389 print CGI::h2("Add Course");
295 390
296 print CGI::start_form("POST", $r->uri); 391 print CGI::start_form("POST", $r->uri);
297 print $self->hidden_authen_fields; 392 print $self->hidden_authen_fields;
… …
313 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)), 408 CGI::td(CGI::textfield("add_courseInstitution", $add_courseInstitution, 25)),
314 ), 409 ),
315 ); 410 );
316 411
317 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below."); 412 print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
318 413 my $checked = ($add_admin_users) ?"checked": ""; # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
319 print CGI::p(CGI::checkbox("add_admin_users", $add_admin_users, "on", "Add WeBWorK administrators to new course")); 414 print CGI::p(CGI::input({-type=>'checkbox', -name=>"add_admin_users", $checked=>'' }, "Add WeBWorK administrators to new course"));
320 415
321 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."); 416 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.");
322 417
323 print CGI::table({class=>"FormLayout"}, CGI::Tr( 418 print CGI::table({class=>"FormLayout"}, CGI::Tr(
324 CGI::td( 419 CGI::td(
… …
378 print CGI::p("Select a database layout below."); 473 print CGI::p("Select a database layout below.");
379 474
380 foreach my $dbLayout (@dbLayouts) { 475 foreach my $dbLayout (@dbLayouts) {
381 print CGI::start_table({class=>"FormLayout"}); 476 print CGI::start_table({class=>"FormLayout"});
382 477
478 my $dbLayoutLabel = (defined $DB_LAYOUT_DESCRIPTIONS{$dbLayout})
479 ? "$dbLayout - $DB_LAYOUT_DESCRIPTIONS{$dbLayout}"
480 : $dbLayout;
481
383 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm 482 # we generate singleton radio button tags ourselves because it's too much of a pain to do it with CGI.pm
384 print CGI::Tr( 483 print CGI::Tr(
385 CGI::td({style=>"text-align: right"}, 484 CGI::td({style=>"text-align: right"},
386 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"' 485 '<input type="radio" name="add_dbLayout" value="' . $dbLayout . '"'
387 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />', 486 . ($add_dbLayout eq $dbLayout ? " checked" : "") . ' />',
388 ), 487 ),
389 CGI::td($dbLayout), 488 CGI::td($dbLayoutLabel),
390 ); 489 );
391 490
392 print CGI::start_Tr(); 491 print CGI::start_Tr();
393 print CGI::td(); # for indentation :( 492 print CGI::td(); # for indentation :(
394 print CGI::start_td(); 493 print CGI::start_td();
395 494
495
396 if ($dbLayout eq "sql") { 496 if ($dbLayout eq "sql") {
497
498 print CGI::p({style=>'font-style:italic'},"The following information is only required for the deprecated sql database format:");
397 print CGI::start_table({class=>"FormLayout"}); 499 print CGI::start_table({class=>"FormLayout"});
398 print CGI::Tr(CGI::td({colspan=>2}, 500 print CGI::Tr(CGI::td({colspan=>2},
399 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database." 501 "Enter the user ID and password for an SQL account with sufficient permissions to create a new database."
400 ) 502 )
401 ); 503 );
… …
447 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."), 549 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."),
448 ), 550 ),
449 ); 551 );
450 print CGI::end_table(); 552 print CGI::end_table();
451 } elsif ($dbLayout eq "gdbm") { 553 } elsif ($dbLayout eq "gdbm") {
554 print CGI::p({style=>"font-style: italic"},"The following information is only required for the deprecated gdbm database format:");
452 print CGI::start_table({class=>"FormLayout"}); 555 print CGI::start_table({class=>"FormLayout"});
453 print CGI::Tr( 556 print CGI::Tr(
454 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"), 557 CGI::th({class=>"LeftHeader"}, "GDBM Global User ID:"),
455 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)), 558 CGI::td(CGI::textfield("add_gdbm_globalUserID", $add_gdbm_globalUserID || "global_user", 25)),
456 ); 559 );
… …
501 604
502 my @errors; 605 my @errors;
503 606
504 if ($add_courseID eq "") { 607 if ($add_courseID eq "") {
505 push @errors, "You must specify a course ID."; 608 push @errors, "You must specify a course ID.";
609 }
610 unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
611 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
506 } 612 }
507 if (grep { $add_courseID eq $_ } listCourses($ce)) { 613 if (grep { $add_courseID eq $_ } listCourses($ce)) {
508 push @errors, "A course with ID $add_courseID already exists."; 614 push @errors, "A course with ID $add_courseID already exists.";
509 } 615 }
510 if ($add_courseTitle eq "") { 616 if ($add_courseTitle eq "") {
… …
594 700
595 my %courseOptions = ( dbLayoutName => $add_dbLayout ); 701 my %courseOptions = ( dbLayoutName => $add_dbLayout );
596 702
597 if ($add_initial_email ne "") { 703 if ($add_initial_email ne "") {
598 $courseOptions{allowedRecipients} = [ $add_initial_email ]; 704 $courseOptions{allowedRecipients} = [ $add_initial_email ];
705 # don't set feedbackRecipients -- this just gets in the way of the more
706 # intelligent "receive_recipients" method.
599 $courseOptions{feedbackRecipients} = [ $add_initial_email ]; 707 #$courseOptions{feedbackRecipients} = [ $add_initial_email ];
600 } 708 }
601 709
602 if ($add_dbLayout eq "gdbm") { 710 if ($add_dbLayout eq "gdbm") {
603 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne ""; 711 $courseOptions{globalUserID} = $add_gdbm_globalUserID if $add_gdbm_globalUserID ne "";
604 } 712 }
… …
616 my @users; 724 my @users;
617 725
618 # copy users from current (admin) course if desired 726 # copy users from current (admin) course if desired
619 if ($add_admin_users ne "") { 727 if ($add_admin_users ne "") {
620 foreach my $userID ($db->listUsers) { 728 foreach my $userID ($db->listUsers) {
729 if ($userID eq $add_initial_userID) {
730 $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
731 next;
732 }
621 my $User = $db->getUser($userID); 733 my $User = $db->getUser($userID);
622 my $Password = $db->getPassword($userID); 734 my $Password = $db->getPassword($userID);
623 my $PermissionLevel = $db->getPermissionLevel($userID); 735 my $PermissionLevel = $db->getPermissionLevel($userID);
624 push @users, [ $User, $Password, $PermissionLevel ]; 736 push @users, [ $User, $Password, $PermissionLevel ];
625 } 737 }
… …
644 permission => "10", 756 permission => "10",
645 ); 757 );
646 push @users, [ $User, $Password, $PermissionLevel ]; 758 push @users, [ $User, $Password, $PermissionLevel ];
647 } 759 }
648 760
649 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->email_address } @users; 761 push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
650 762
651 my %optional_arguments; 763 my %optional_arguments;
652 if ($add_templates_course ne "") { 764 if ($add_templates_course ne "") {
653 $optional_arguments{templatesFrom} = $add_templates_course; 765 $optional_arguments{templatesFrom} = $add_templates_course;
654 } 766 }
… …
707 819
708} 820}
709 821
710################################################################################ 822################################################################################
711 823
824sub rename_course_form {
825 my ($self) = @_;
826 my $r = $self->r;
827 my $ce = $r->ce;
828 #my $db = $r->db;
829 #my $authz = $r->authz;
830 #my $urlpath = $r->urlpath;
831
832 my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
833 my $rename_newCourseID = $r->param("rename_newCourseID") || "";
834
835 my $rename_sql_host = $r->param("rename_sql_host") || "";
836 my $rename_sql_port = $r->param("rename_sql_port") || "";
837 my $rename_sql_username = $r->param("rename_sql_username") || "";
838 my $rename_sql_password = $r->param("rename_sql_password") || "";
839 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
840 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
841 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
842
843 my @courseIDs = listCourses($ce);
844 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
845
846 my %courseLabels; # records... heh.
847 foreach my $courseID (@courseIDs) {
848 my $tempCE = WeBWorK::CourseEnvironment->new(
849 $ce->{webworkDirs}->{root},
850 $ce->{webworkURLs}->{root},
851 $ce->{pg}->{directories}->{root},
852 $courseID,
853 );
854 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
855 }
856
857 print CGI::h2("Rename Course");
858
859 print CGI::start_form("POST", $r->uri);
860 print $self->hidden_authen_fields;
861 print $self->hidden_fields("subDisplay");
862
863 print CGI::p("Select a course to rename.");
864
865 print CGI::table({class=>"FormLayout"},
866 CGI::Tr(
867 CGI::th({class=>"LeftHeader"}, "Course Name:"),
868 CGI::td(
869 CGI::scrolling_list(
870 -name => "rename_oldCourseID",
871 -values => \@courseIDs,
872 -default => $rename_oldCourseID,
873 -size => 10,
874 -multiple => 0,
875 -labels => \%courseLabels,
876 ),
877 ),
878 ),
879 CGI::Tr(
880 CGI::th({class=>"LeftHeader"}, "New Name:"),
881 CGI::td(CGI::textfield("rename_newCourseID", $rename_newCourseID, 25)),
882 ),
883 );
884
885 print CGI::p(
886 "If the course's database layout (indicated in parentheses above) is "
887 . CGI::b("sql") . ", supply the SQL connections information requested below."
888 );
889
890 print CGI::start_table({class=>"FormLayout"});
891 print CGI::Tr(CGI::td({colspan=>2},
892 "Enter the user ID and password for an SQL account with sufficient permissions to create and delete databases."
893 )
894 );
895 print CGI::Tr(
896 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
897 CGI::td(CGI::textfield("rename_sql_username", $rename_sql_username, 25)),
898 );
899 print CGI::Tr(
900 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
901 CGI::td(CGI::password_field("rename_sql_password", $rename_sql_password, 25)),
902 );
903
904 print CGI::Tr(
905 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
906 CGI::td(
907 CGI::textfield("rename_sql_host", $rename_sql_host, 25),
908 CGI::br(),
909 CGI::small("Leave blank to use the default host."),
910 ),
911 );
912 print CGI::Tr(
913 CGI::th({class=>"LeftHeader"}, "SQL Server Port:"),
914 CGI::td(
915 CGI::textfield("rename_sql_port", $rename_sql_port, 25),
916 CGI::br(),
917 CGI::small("Leave blank to use the default port."),
918 ),
919 );
920
921 print CGI::Tr(
922 CGI::th({class=>"LeftHeader"}, "SQL Current Database Name:"),
923 CGI::td(
924 CGI::textfield("rename_sql_database", $rename_sql_oldDatabase, 25),
925 CGI::br(),
926 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
927 ),
928 );
929 print CGI::Tr(
930 CGI::th({class=>"LeftHeader"}, "SQL New Database Name:"),
931 CGI::td(
932 CGI::textfield("rename_sql_database", $rename_sql_newDatabase, 25),
933 CGI::br(),
934 CGI::small("Leave blank to use the name ", CGI::tt("webwork_COURSENAME"), "."),
935 ),
936 );
937 print CGI::Tr(
938 CGI::th({class=>"LeftHeader"}, "WeBWorK Host:"),
939 CGI::td(
940 CGI::textfield("rename_sql_wwhost", $rename_sql_wwhost || "localhost", 25),
941 CGI::br(),
942 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."),
943 ),
944 );
945 print CGI::end_table();
946
947 print CGI::p({style=>"text-align: center"}, CGI::submit("rename_course", "Rename Course"));
948
949 print CGI::end_form();
950}
951
952sub rename_course_validate {
953 my ($self) = @_;
954 my $r = $self->r;
955 my $ce = $r->ce;
956 #my $db = $r->db;
957 #my $authz = $r->authz;
958 #my $urlpath = $r->urlpath;
959
960 my $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
961 my $rename_newCourseID = $r->param("rename_newCourseID") || "";
962
963 my $rename_sql_host = $r->param("rename_sql_host") || "";
964 my $rename_sql_port = $r->param("rename_sql_port") || "";
965 my $rename_sql_username = $r->param("rename_sql_username") || "";
966 my $rename_sql_password = $r->param("rename_sql_password") || "";
967 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
968 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
969 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
970
971 my @errors;
972
973 if ($rename_oldCourseID eq "") {
974 push @errors, "You must select a course to rename.";
975 }
976 if ($rename_newCourseID eq "") {
977 push @errors, "You must specify a new name for the course.";
978 }
979 if ($rename_oldCourseID eq $rename_newCourseID) {
980 push @errors, "Can't rename to the same name.";
981 }
982 unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
983 push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
984 }
985 if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
986 push @errors, "A course with ID $rename_newCourseID already exists.";
987 }
988
989 my $ce2 = WeBWorK::CourseEnvironment->new(
990 $ce->{webworkDirs}->{root},
991 $ce->{webworkURLs}->{root},
992 $ce->{pg}->{directories}->{root},
993 $rename_oldCourseID,
994 );
995
996 if ($ce2->{dbLayoutName} eq "sql") {
997 push @errors, "You must specify the SQL admin username." if $rename_sql_username eq "";
998 #push @errors, "You must specify the SQL admin password." if $rename_sql_password eq "";
999 #push @errors, "You must specify the current SQL database name." if $rename_sql_oldDatabase eq "";
1000 #push @errors, "You must specify the new SQL database name." if $rename_sql_newDatabase eq "";
1001 }
1002
1003 return @errors;
1004}
1005
1006sub do_rename_course {
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 $rename_oldCourseID = $r->param("rename_oldCourseID") || "";
1015 my $rename_newCourseID = $r->param("rename_newCourseID") || "";
1016
1017 my $rename_sql_host = $r->param("rename_sql_host") || "";
1018 my $rename_sql_port = $r->param("rename_sql_port") || "";
1019 my $rename_sql_username = $r->param("rename_sql_username") || "";
1020 my $rename_sql_password = $r->param("rename_sql_password") || "";
1021 my $rename_sql_oldDatabase = $r->param("rename_sql_oldDatabase") || "";
1022 my $rename_sql_newDatabase = $r->param("rename_sql_newDatabase") || "";
1023 my $rename_sql_wwhost = $r->param("rename_sql_wwhost") || "";
1024
1025 my $ce2 = WeBWorK::CourseEnvironment->new(
1026 $ce->{webworkDirs}->{root},
1027 $ce->{webworkURLs}->{root},
1028 $ce->{pg}->{directories}->{root},
1029 $rename_oldCourseID,
1030 );
1031
1032 my $dbLayoutName = $ce->{dbLayoutName};
1033
1034 my %dbOptions;
1035 if ($dbLayoutName eq "sql") {
1036 $dbOptions{host} = $rename_sql_host if $rename_sql_host ne "";
1037 $dbOptions{port} = $rename_sql_port if $rename_sql_port ne "";
1038 $dbOptions{username} = $rename_sql_username;
1039 $dbOptions{password} = $rename_sql_password;
1040 $dbOptions{old_database} = $rename_sql_oldDatabase || "webwork_$rename_oldCourseID";
1041 $dbOptions{new_database} = $rename_sql_newDatabase || "webwork_$rename_newCourseID";
1042 $dbOptions{wwhost} = $rename_sql_wwhost;
1043 }
1044
1045 eval {
1046 renameCourse(
1047 courseID => $rename_oldCourseID,
1048 ce => $ce2,
1049 dbOptions => \%dbOptions,
1050 newCourseID => $rename_newCourseID,
1051 );
1052 };
1053 if ($@) {
1054 my $error = $@;
1055 print CGI::div({class=>"ResultsWithError"},
1056 CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
1057 CGI::tt(CGI::escapeHTML($error)),
1058 );
1059 } else {
1060 print CGI::div({class=>"ResultsWithoutError"},
1061 CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
1062 );
1063 my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",
1064 courseID => $rename_newCourseID);
1065 my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
1066 print CGI::div({style=>"text-align: center"},
1067 CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
1068 );
1069 }
1070}
1071
1072################################################################################
1073
712sub delete_course_form { 1074sub delete_course_form {
713 my ($self) = @_; 1075 my ($self) = @_;
714 my $r = $self->r; 1076 my $r = $self->r;
715 my $ce = $r->ce; 1077 my $ce = $r->ce;
716 #my $db = $r->db; 1078 #my $db = $r->db;
… …
723 my $delete_sql_username = $r->param("delete_sql_username") || ""; 1085 my $delete_sql_username = $r->param("delete_sql_username") || "";
724 my $delete_sql_password = $r->param("delete_sql_password") || ""; 1086 my $delete_sql_password = $r->param("delete_sql_password") || "";
725 my $delete_sql_database = $r->param("delete_sql_database") || ""; 1087 my $delete_sql_database = $r->param("delete_sql_database") || "";
726 1088
727 my @courseIDs = listCourses($ce); 1089 my @courseIDs = listCourses($ce);
728 @courseIDs = sort @courseIDs; 1090 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
729 1091
730 my %courseLabels; # records... heh. 1092 my %courseLabels; # records... heh.
731 foreach my $courseID (@courseIDs) { 1093 foreach my $courseID (@courseIDs) {
732 my $tempCE = WeBWorK::CourseEnvironment->new( 1094 my $tempCE = WeBWorK::CourseEnvironment->new(
733 $ce->{webworkDirs}->{root}, 1095 $ce->{webworkDirs}->{root},
… …
766 "If the course's database layout (indicated in parentheses above) is " 1128 "If the course's database layout (indicated in parentheses above) is "
767 . CGI::b("sql") . ", supply the SQL connections information requested below." 1129 . CGI::b("sql") . ", supply the SQL connections information requested below."
768 ); 1130 );
769 1131
770 print CGI::start_table({class=>"FormLayout"}); 1132 print CGI::start_table({class=>"FormLayout"});
1133 print CGI::Tr(CGI::td({colspan=>2},
1134 "Enter the user ID and password for an SQL account with sufficient permissions to delete an existing database."
1135 )
1136 );
1137 print CGI::Tr(
1138 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
1139 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
1140 );
1141 print CGI::Tr(
1142 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
1143 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
1144 );
1145
1146 #print CGI::Tr(CGI::td({colspan=>2},
1147 # "The optionial SQL settings you enter below must match the settings in the DBI source"
1148 # . " specification " . CGI::tt($dbi_source) . ". Replace " . CGI::tt("COURSENAME")
1149 # . " with the course name you entered above."
1150 # )
1151 #);
771 print CGI::Tr( 1152 print CGI::Tr(
772 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"), 1153 CGI::th({class=>"LeftHeader"}, "SQL Server Host:"),
773 CGI::td( 1154 CGI::td(
774 CGI::textfield("delete_sql_host", $delete_sql_host, 25), 1155 CGI::textfield("delete_sql_host", $delete_sql_host, 25),
775 CGI::br(), 1156 CGI::br(),
… …
782 CGI::textfield("delete_sql_port", $delete_sql_port, 25), 1163 CGI::textfield("delete_sql_port", $delete_sql_port, 25),
783 CGI::br(), 1164 CGI::br(),
784 CGI::small("Leave blank to use the default port."), 1165 CGI::small("Leave blank to use the default port."),
785 ), 1166 ),
786 ); 1167 );
787 print CGI::Tr( 1168
788 CGI::th({class=>"LeftHeader"}, "SQL Admin Username:"),
789 CGI::td(CGI::textfield("delete_sql_username", $delete_sql_username, 25)),
790 );
791 print CGI::Tr(
792 CGI::th({class=>"LeftHeader"}, "SQL Admin Password:"),
793 CGI::td(CGI::password_field("delete_sql_password", $delete_sql_password, 25)),
794 );
795 print CGI::Tr( 1169 print CGI::Tr(
796 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"), 1170 CGI::th({class=>"LeftHeader"}, "SQL Database Name:"),
797 CGI::td( 1171 CGI::td(
798 CGI::textfield("delete_sql_database", $delete_sql_database, 25), 1172 CGI::textfield("delete_sql_database", $delete_sql_database, 25),
799 CGI::br(), 1173 CGI::br(),
… …
983 1357
984 my @tables = keys %{$ce->{dbLayout}}; 1358 my @tables = keys %{$ce->{dbLayout}};
985 1359
986 my $export_courseID = $r->param("export_courseID") || ""; 1360 my $export_courseID = $r->param("export_courseID") || "";
987 my @export_tables = $r->param("export_tables"); 1361 my @export_tables = $r->param("export_tables");
988 1362
989 @export_tables = @tables unless @export_tables; 1363 @export_tables = @tables unless @export_tables;
990 1364
991 my @courseIDs = listCourses($ce); 1365 my @courseIDs = listCourses($ce);
992 @courseIDs = sort @courseIDs; 1366 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
993 1367
994 my %courseLabels; # records... heh. 1368 my %courseLabels; # records... heh.
995 foreach my $courseID (@courseIDs) { 1369 foreach my $courseID (@courseIDs) {
996 my $tempCE = WeBWorK::CourseEnvironment->new( 1370 my $tempCE = WeBWorK::CourseEnvironment->new(
997 $ce->{webworkDirs}->{root}, 1371 $ce->{webworkDirs}->{root},
… …
1006 1380
1007 print CGI::start_form("GET", $r->uri); 1381 print CGI::start_form("GET", $r->uri);
1008 print $self->hidden_authen_fields; 1382 print $self->hidden_authen_fields;
1009 print $self->hidden_fields("subDisplay"); 1383 print $self->hidden_fields("subDisplay");
1010 1384
1011 print CGI::p("Select a course to export the course's database."); 1385 print CGI::p("Select a course to export the course's database. Please note
1386 that exporting can take a very long time for a large course. If you have
1387 shell access to the WeBWorK server, you may use the ", CGI::code("wwdb"), "
1388 utility instead.");
1012 1389
1013 print CGI::table({class=>"FormLayout"}, 1390 print CGI::table({class=>"FormLayout"},
1014 CGI::Tr( 1391 CGI::Tr(
1015 CGI::th({class=>"LeftHeader"}, "Course Name:"), 1392 CGI::th({class=>"LeftHeader"}, "Course Name:"),
1016 CGI::td( 1393 CGI::td(
1017 CGI::scrolling_list( 1394 CGI::scrolling_list(
1018 -name => "export_courseID", 1395 -name => "export_courseID",
1019 -values => \@courseIDs, 1396 -values => \@courseIDs,
1020 -default => $export_courseID, 1397 -default => $export_courseID,
1021 -size => 10, 1398 -size => 10,
1022 -multiple => 0, 1399 -multiple => 1,
1023 -labels => \%courseLabels, 1400 -labels => \%courseLabels,
1024 ), 1401 ),
1025 ), 1402 ),
1026 ), 1403 ),
1027 CGI::Tr( 1404 CGI::Tr(
… …
1048 #my $ce = $r->ce; 1425 #my $ce = $r->ce;
1049 #my $db = $r->db; 1426 #my $db = $r->db;
1050 #my $authz = $r->authz; 1427 #my $authz = $r->authz;
1051 #my $urlpath = $r->urlpath; 1428 #my $urlpath = $r->urlpath;
1052 1429
1053 my $export_courseID = $r->param("export_courseID") || ""; 1430 my @export_courseID = $r->param("export_courseID") || ();
1054 my @export_tables = $r->param("export_tables"); 1431 my @export_tables = $r->param("export_tables");
1055 1432
1056 my @errors; 1433 my @errors;
1057 1434
1058 if ($export_courseID eq "") { 1435 unless ( @export_courseID) {
1059 push @errors, "You must specify a course name."; 1436 push @errors, "You must specify at least one course name.";
1060 } 1437 }
1061 1438
1062 unless (@export_tables) { 1439 unless (@export_tables) {
1063 push @errors, "You must specify at least one table to export."; 1440 push @errors, "You must specify at least one table to export.";
1064 } 1441 }
… …
1072 my $ce = $r->ce; 1449 my $ce = $r->ce;
1073 #my $db = $r->db; 1450 #my $db = $r->db;
1074 #my $authz = $r->authz; 1451 #my $authz = $r->authz;
1075 my $urlpath = $r->urlpath; 1452 my $urlpath = $r->urlpath;
1076 1453
1077 my $export_courseID = $r->param("export_courseID"); 1454 my @export_courseID = $r->param("export_courseID");
1078 my @export_tables = $r->param("export_tables"); 1455 my @export_tables = $r->param("export_tables");
1079 1456
1457 foreach my $export_courseID (@export_courseID) {
1458
1080 my $ce2 = WeBWorK::CourseEnvironment->new( 1459 my $ce2 = WeBWorK::CourseEnvironment->new(
1081 $ce->{webworkDirs}->{root}, 1460 $ce->{webworkDirs}->{root},
1082 $ce->{webworkURLs}->{root}, 1461 $ce->{webworkURLs}->{root},
1083 $ce->{pg}->{directories}->{root}, 1462 $ce->{pg}->{directories}->{root},
1084 $export_courseID, 1463 $export_courseID,
1085 ); 1464 );
1086 1465
1087 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1466 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1088 1467
1089 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1468 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1090 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1469 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1470 # export to the admin/templates directory
1471 my $exportFileName = "$export_courseID.exported.xml";
1472 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
1473 # get a unique name
1474 my $number =1;
1475 while (-e "$exportFilePath.$number.gz") {
1476 $number++;
1477 last if $number>9;
1478 }
1479 if ($number<=9 ) {
1480 $exportFilePath = "$exportFilePath.$number";
1481 $exportFileName = "$exportFileName.$number";
1482 } else {
1483 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
1484 remove some of these files."));
1485 $exportFilePath = "$exportFilePath.999";
1486 $exportFileName = "$exportFileName.999";
1487 }
1091 1488
1489 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1490
1092 my @errors; 1491 my @errors;
1093
1094 eval { 1492 eval {
1095 @errors = dbExport( 1493 @errors = dbExport(
1096 db => $db2, 1494 db => $db2,
1097 #xml => $fh, 1495 #xml => $fh,
1098 xml => *STDOUT, 1496 xml => $outputFileHandle,
1099 tables => \@export_tables, 1497 tables => \@export_tables,
1100 ); 1498 );
1101 }; 1499 };
1500
1501 $outputFileHandle->close();
1102 1502
1503 my $gzipMessage = system( 'gzip', $exportFilePath);
1504 if ( !$gzipMessage ) {
1505 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
1506 You may download it with the file manager."));
1507 } else {
1508 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
1509 }
1510 unlink $exportFilePath;
1511 } # end export of one course
1103 #push @errors, "Fatal exception: $@" if $@; 1512 #push @errors, "Fatal exception: $@" if $@;
1104 # 1513 #
1105 #if (@errors) { 1514 #if (@errors) {
1106 # print CGI::div({class=>"ResultsWithError"}, 1515 # print CGI::div({class=>"ResultsWithError"},
1107 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1516 # CGI::p("An error occured while exporting the database of course $export_courseID:"),
… …
1136 my $import_conflict = $r->param("import_conflict") || "skip"; 1545 my $import_conflict = $r->param("import_conflict") || "skip";
1137 1546
1138 @import_tables = @tables unless @import_tables; 1547 @import_tables = @tables unless @import_tables;
1139 1548
1140 my @courseIDs = listCourses($ce); 1549 my @courseIDs = listCourses($ce);
1141 @courseIDs = sort @courseIDs; 1550 @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
1142 1551
1143 1552
1144 my %courseLabels; # records... heh. 1553 my %courseLabels; # records... heh.
1145 foreach my $courseID (@courseIDs) { 1554 foreach my $courseID (@courseIDs) {
1146 my $tempCE = WeBWorK::CourseEnvironment->new( 1555 my $tempCE = WeBWorK::CourseEnvironment->new(
… …
1150 $courseID, 1559 $courseID,
1151 ); 1560 );
1152 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1561 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1153 } 1562 }
1154 1563
1564 # find databases:
1565 my $templatesDir = $ce->{courseDirs}->{templates};
1566 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
1567 my $exempt_dirs = join("|", keys %probLibs);
1568
1569 my @databaseFiles = listFilesRecursive(
1570 $templatesDir,
1571 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
1572 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories
1573 0, # match against file name only
1574 1, # prune against path relative to $templatesDir
1575 );
1576
1577 my %databaseLabels = map { ($_ => $_) } @databaseFiles;
1578
1579 #######
1580
1155 print CGI::h2("Import Database"); 1581 print CGI::h2("Import Database");
1156 1582
1157 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1583 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1158 print $self->hidden_authen_fields; 1584 print $self->hidden_authen_fields;
1159 print $self->hidden_fields("subDisplay"); 1585 print $self->hidden_fields("subDisplay");
1160 1586
1161 print CGI::table({class=>"FormLayout"}, 1587 print CGI::table({class=>"FormLayout"},
1162 CGI::Tr( 1588 CGI::Tr(
1163 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1589 CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1590# CGI::td(
1591# CGI::filefield(
1592# -name => "import_file",
1593# -size => 50,
1594# ),
1595# ),
1164 CGI::td( 1596 CGI::td(
1165 CGI::filefield( 1597 CGI::scrolling_list(
1166 -name => "import_file", 1598 -name => "import_file",
1599 -values => \@databaseFiles,
1600 -default => undef,
1167 -size => 50, 1601 -size => 10,
1168 ), 1602 -multiple => 0,
1603 -labels => \%databaseLabels,
1169 ), 1604 ),
1605
1606 )
1170 ), 1607 ),
1171 CGI::Tr( 1608 CGI::Tr(
1172 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1609 CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1173 CGI::td( 1610 CGI::td(
1174 CGI::checkbox_group( 1611 CGI::checkbox_group(
… …
1228 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1665 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked
1229 1666
1230 my @errors; 1667 my @errors;
1231 1668
1232 if ($import_file eq "") { 1669 if ($import_file eq "") {
1233 push @errors, "You must specify a database file to upload."; 1670 push @errors, "You must specify a database file to import.";
1234 } 1671 }
1235 1672
1236 if ($import_courseID eq "") { 1673 if ($import_courseID eq "") {
1237 push @errors, "You must specify a course name."; 1674 push @errors, "You must specify a course name.";
1238 } 1675 }
… …
1264 $import_courseID, 1701 $import_courseID,
1265 ); 1702 );
1266 1703
1267 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1704 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1268 1705
1706 # locate file
1707 my $templateDir = $ce->{courseDirs}->{templates};
1708 my $filePath = "$templateDir/$import_file";
1709
1710 my $gunzipMessage = system( 'gunzip', $filePath);
1711 #FIXME
1712 #warn "gunzip ", $gunzipMessage;
1713 $filePath =~ s/\.gz$//;
1714 #warn "new file path is $filePath";
1715 my $fileHandle = new IO::File("<$filePath");
1269 # retrieve upload from upload cache 1716 # retrieve upload from upload cache
1270 my ($id, $hash) = split /\s+/, $import_file; 1717# my ($id, $hash) = split /\s+/, $import_file;
1271 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1718# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1272 dir => $ce->{webworkDirs}->{uploadCache} 1719# dir => $ce->{webworkDirs}->{uploadCache}
1273 ); 1720# );
1274 1721
1275 my @errors; 1722 my @errors;
1276 1723
1277 eval { 1724 eval {
1278 @errors = dbImport( 1725 @errors = dbImport(
1279 db => $db2, 1726 db => $db2,
1280 xml => $upload->fileHandle, 1727 # xml => $upload->fileHandle,
1728 xml => $fileHandle,
1281 tables => \@import_tables, 1729 tables => \@import_tables,
1282 conflict => $import_conflict, 1730 conflict => $import_conflict,
1283 ); 1731 );
1284 }; 1732 };
1285 1733
1286 $upload->dispose;
1287
1288 push @errors, "Fatal exception: $@" if $@; 1734 push @errors, "Fatal exception: $@" if $@;
1735 push @errors, $gunzipMessage if $gunzipMessage;
1289 1736
1290 if (@errors) { 1737 if (@errors) {
1291 print CGI::div({class=>"ResultsWithError"}, 1738 print CGI::div({class=>"ResultsWithError"},
1292 CGI::p("An error occured while importing the database of course $import_courseID:"), 1739 CGI::p("An error occured while importing the database of course $import_courseID:"),
1293 CGI::ul(CGI::li(\@errors)), 1740 CGI::ul(CGI::li(\@errors)),
Legend:
Removed from v.2479  
changed lines
  Added in v.3437
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9