[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 3059 Revision 3235
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: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.31 2004/10/10 21:04:47 sh002i Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.33 2004/12/21 04:40:56 sh002i Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
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 renameCourse 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);
35 36
36# put the following database layouts at the top of the list, in this order 37# put the following database layouts at the top of the list, in this order
37our @DB_LAYOUT_ORDER = qw/sql_single gdbm sql/; 38our @DB_LAYOUT_ORDER = qw/sql_single gdbm sql/;
… …
171} 172}
172 173
173sub header { 174sub header {
174 my ($self) = @_; 175 my ($self) = @_;
175 my $method_to_call = $self->{method_to_call}; 176 my $method_to_call = $self->{method_to_call};
176 if (defined $method_to_call and $method_to_call eq "do_export_database") { 177# if (defined $method_to_call and $method_to_call eq "do_export_database") {
177 my $r = $self->r; 178# my $r = $self->r;
178 my $courseID = $r->param("export_courseID"); 179# my $courseID = $r->param("export_courseID");
179 $r->content_type("application/octet-stream"); 180# $r->content_type("application/octet-stream");
180 $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\""); 181# $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
181 $r->send_http_header; 182# $r->send_http_header;
182 } else { 183# } else {
183 $self->SUPER::header; 184 $self->SUPER::header;
184 } 185# }
185} 186}
186 187
187# sends: 188# sends:
188# 189#
189# HTTP/1.1 200 OK 190# HTTP/1.1 200 OK
… …
195 196
196sub content { 197sub content {
197 my ($self) = @_; 198 my ($self) = @_;
198 my $method_to_call = $self->{method_to_call}; 199 my $method_to_call = $self->{method_to_call};
199 if (defined $method_to_call and $method_to_call eq "do_export_database") { 200 if (defined $method_to_call and $method_to_call eq "do_export_database") {
200 $self->do_export_database; 201 #$self->do_export_database;
202 $self->SUPER::content;
201 } else { 203 } else {
202 $self->SUPER::content; 204 $self->SUPER::content;
203 } 205 }
204} 206}
205 207
… …
215 217
216 # check permissions 218 # check permissions
217 unless ($authz->hasPermissions($user, "create_and_delete_courses")) { 219 unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
218 return ""; 220 return "";
219 } 221 }
222 my $method_to_call = $self->{method_to_call};
223 my $methodMessage ="";
224
225 (defined($method_to_call) and $method_to_call eq "do_export_database") && do {
226 my @export_courseID = $r->param("export_courseID");
227 my $course_ids = join(", ", @export_courseID);
228 $methodMessage = CGI::p("Exporting database for course(s) $course_ids").
229 CGI::p(".... please wait....
230 If your browser times out you will
231 still be able to download the exported database using the
232 file manager.").CGI::hr();
233 };
234
220 235
221 print CGI::p({style=>"text-align: center"}, 236 print CGI::p({style=>"text-align: center"},
222 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"), 237 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course"})}, "Add Course"),
223 " | ", 238 " | ",
224 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"), 239 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
… …
226 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"), 241 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
227 " | ", 242 " | ",
228 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"), 243 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
229 " | ", 244 " | ",
230 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"), 245 CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
246 CGI::hr(),
247 $methodMessage,
248
231 ); 249 );
232 250
233 print CGI::hr(); 251 print CGI::p("The ability to import and to export databases is still under development.
252 It seems to work but it is <b>VERY</b> slow on large courses. You may prefer to
253 use webwork2/bin/wwdb or the mysql dump facility for archiving large courses.
254 Please send bug reports if you find errors. ");
234 255
235 my @errors = @{$self->{errors}}; 256 my @errors = @{$self->{errors}};
236 my $method_to_call = $self->{method_to_call}; 257
237 258
238 if (@errors) { 259 if (@errors) {
239 print CGI::div({class=>"ResultsWithError"}, 260 print CGI::div({class=>"ResultsWithError"},
240 CGI::p("Please correct the following errors and try again:"), 261 CGI::p("Please correct the following errors and try again:"),
241 CGI::ul(CGI::li(\@errors)), 262 CGI::ul(CGI::li(\@errors)),
… …
1297 1318
1298 my @tables = keys %{$ce->{dbLayout}}; 1319 my @tables = keys %{$ce->{dbLayout}};
1299 1320
1300 my $export_courseID = $r->param("export_courseID") || ""; 1321 my $export_courseID = $r->param("export_courseID") || "";
1301 my @export_tables = $r->param("export_tables"); 1322 my @export_tables = $r->param("export_tables");
1302 1323
1303 @export_tables = @tables unless @export_tables; 1324 @export_tables = @tables unless @export_tables;
1304 1325
1305 my @courseIDs = listCourses($ce); 1326 my @courseIDs = listCourses($ce);
1306 @courseIDs = sort @courseIDs; 1327 @courseIDs = sort @courseIDs;
1307 1328
… …
1334 CGI::scrolling_list( 1355 CGI::scrolling_list(
1335 -name => "export_courseID", 1356 -name => "export_courseID",
1336 -values => \@courseIDs, 1357 -values => \@courseIDs,
1337 -default => $export_courseID, 1358 -default => $export_courseID,
1338 -size => 10, 1359 -size => 10,
1339 -multiple => 0, 1360 -multiple => 1,
1340 -labels => \%courseLabels, 1361 -labels => \%courseLabels,
1341 ), 1362 ),
1342 ), 1363 ),
1343 ), 1364 ),
1344 CGI::Tr( 1365 CGI::Tr(
… …
1365 #my $ce = $r->ce; 1386 #my $ce = $r->ce;
1366 #my $db = $r->db; 1387 #my $db = $r->db;
1367 #my $authz = $r->authz; 1388 #my $authz = $r->authz;
1368 #my $urlpath = $r->urlpath; 1389 #my $urlpath = $r->urlpath;
1369 1390
1370 my $export_courseID = $r->param("export_courseID") || ""; 1391 my @export_courseID = $r->param("export_courseID") || ();
1371 my @export_tables = $r->param("export_tables"); 1392 my @export_tables = $r->param("export_tables");
1372 1393
1373 my @errors; 1394 my @errors;
1374 1395
1375 if ($export_courseID eq "") { 1396 unless ( @export_courseID) {
1376 push @errors, "You must specify a course name."; 1397 push @errors, "You must specify at least one course name.";
1377 } 1398 }
1378 1399
1379 unless (@export_tables) { 1400 unless (@export_tables) {
1380 push @errors, "You must specify at least one table to export."; 1401 push @errors, "You must specify at least one table to export.";
1381 } 1402 }
… …
1389 my $ce = $r->ce; 1410 my $ce = $r->ce;
1390 #my $db = $r->db; 1411 #my $db = $r->db;
1391 #my $authz = $r->authz; 1412 #my $authz = $r->authz;
1392 my $urlpath = $r->urlpath; 1413 my $urlpath = $r->urlpath;
1393 1414
1394 my $export_courseID = $r->param("export_courseID"); 1415 my @export_courseID = $r->param("export_courseID");
1395 my @export_tables = $r->param("export_tables"); 1416 my @export_tables = $r->param("export_tables");
1396 1417
1418 foreach my $export_courseID (@export_courseID) {
1419
1397 my $ce2 = WeBWorK::CourseEnvironment->new( 1420 my $ce2 = WeBWorK::CourseEnvironment->new(
1398 $ce->{webworkDirs}->{root}, 1421 $ce->{webworkDirs}->{root},
1399 $ce->{webworkURLs}->{root}, 1422 $ce->{webworkURLs}->{root},
1400 $ce->{pg}->{directories}->{root}, 1423 $ce->{pg}->{directories}->{root},
1401 $export_courseID, 1424 $export_courseID,
1402 ); 1425 );
1403 1426
1404 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1427 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1405 1428
1406 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp}); 1429 #my ($fh, $export_file) = tempfile("db_export_XXXXXX", DIR => $ce->{webworkDirs}->{tmp});
1407 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/; 1430 #my ($random_chars) = $export_file =~ m/db_export_(\w+)$/;
1431 # export to the admin/templates directory
1432 my $exportFileName = "$export_courseID.exported.xml";
1433 my $exportFilePath = $ce->{courseDirs}->{templates}."/$exportFileName";
1434 # get a unique name
1435 my $number =1;
1436 while (-e "$exportFilePath.$number.gz") {
1437 $number++;
1438 last if $number>9;
1439 }
1440 if ($number<=9 ) {
1441 $exportFilePath = "$exportFilePath.$number";
1442 $exportFileName = "$exportFileName.$number";
1443 } else {
1444 $self->addbadmessage(CGI::p("There are more than 9 exported files for this course! Please
1445 remove some of these files."));
1446 $exportFilePath = "$exportFilePath.999";
1447 $exportFileName = "$exportFileName.999";
1448 }
1408 1449
1450 my $outputFileHandle = new IO::File(">$exportFilePath") or warn "Unable to create $exportFilePath";
1451
1409 my @errors; 1452 my @errors;
1410
1411 eval { 1453 eval {
1412 @errors = dbExport( 1454 @errors = dbExport(
1413 db => $db2, 1455 db => $db2,
1414 #xml => $fh, 1456 #xml => $fh,
1415 xml => *STDOUT, 1457 xml => $outputFileHandle,
1416 tables => \@export_tables, 1458 tables => \@export_tables,
1417 ); 1459 );
1418 }; 1460 };
1461
1462 $outputFileHandle->close();
1419 1463
1464 my $gzipMessage = system( 'gzip', $exportFilePath);
1465 if ( !$gzipMessage ) {
1466 $self->addgoodmessage(CGI::p( "Database saved to templates/$exportFileName.gzip.
1467 You may download it with the file manager."));
1468 } else {
1469 $self->addbadmessage(CGI::p( "Failed to gzip file $exportFilePath"));
1470 }
1471 unlink $exportFilePath;
1472 } # end export of one course
1420 #push @errors, "Fatal exception: $@" if $@; 1473 #push @errors, "Fatal exception: $@" if $@;
1421 # 1474 #
1422 #if (@errors) { 1475 #if (@errors) {
1423 # print CGI::div({class=>"ResultsWithError"}, 1476 # print CGI::div({class=>"ResultsWithError"},
1424 # CGI::p("An error occured while exporting the database of course $export_courseID:"), 1477 # CGI::p("An error occured while exporting the database of course $export_courseID:"),
… …
1467 $courseID, 1520 $courseID,
1468 ); 1521 );
1469 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")"; 1522 $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
1470 } 1523 }
1471 1524
1525 # find databases:
1526 my $templatesDir = $ce->{courseDirs}->{templates};
1527 my %probLibs = %{ $r->ce->{courseFiles}->{problibs} };
1528 my $exempt_dirs = join("|", keys %probLibs);
1529
1530 my @databaseFiles = listFilesRecursive(
1531 $templatesDir,
1532 qr/.\.exported\.xml\.\d*\.gz$/, # match these files #FIXME this is too restricive!!
1533 qr/^(?:$exempt_dirs|CVS)$/, # prune these directories
1534 0, # match against file name only
1535 1, # prune against path relative to $templatesDir
1536 );
1537
1538 my %databaseLabels = map { ($_ => $_) } @databaseFiles;
1539
1540 #######
1541
1472 print CGI::h2("Import Database"); 1542 print CGI::h2("Import Database");
1473 1543
1474 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART); 1544 print CGI::start_form("POST", $r->uri, &CGI::MULTIPART);
1475 print $self->hidden_authen_fields; 1545 print $self->hidden_authen_fields;
1476 print $self->hidden_fields("subDisplay"); 1546 print $self->hidden_fields("subDisplay");
1477 1547
1478 print CGI::table({class=>"FormLayout"}, 1548 print CGI::table({class=>"FormLayout"},
1479 CGI::Tr( 1549 CGI::Tr(
1480 CGI::th({class=>"LeftHeader"}, "Database XML File:"), 1550 CGI::th({class=>"LeftHeader"}, "Database XML File:"),
1551# CGI::td(
1552# CGI::filefield(
1553# -name => "import_file",
1554# -size => 50,
1555# ),
1556# ),
1481 CGI::td( 1557 CGI::td(
1482 CGI::filefield( 1558 CGI::scrolling_list(
1483 -name => "import_file", 1559 -name => "import_file",
1560 -values => \@databaseFiles,
1561 -default => undef,
1484 -size => 50, 1562 -size => 10,
1485 ), 1563 -multiple => 0,
1564 -labels => \%databaseLabels,
1486 ), 1565 ),
1566
1567 )
1487 ), 1568 ),
1488 CGI::Tr( 1569 CGI::Tr(
1489 CGI::th({class=>"LeftHeader"}, "Tables to Import:"), 1570 CGI::th({class=>"LeftHeader"}, "Tables to Import:"),
1490 CGI::td( 1571 CGI::td(
1491 CGI::checkbox_group( 1572 CGI::checkbox_group(
… …
1545 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked 1626 #my $import_conflict = $r->param("import_conflict") || "skip"; # not checked
1546 1627
1547 my @errors; 1628 my @errors;
1548 1629
1549 if ($import_file eq "") { 1630 if ($import_file eq "") {
1550 push @errors, "You must specify a database file to upload."; 1631 push @errors, "You must specify a database file to import.";
1551 } 1632 }
1552 1633
1553 if ($import_courseID eq "") { 1634 if ($import_courseID eq "") {
1554 push @errors, "You must specify a course name."; 1635 push @errors, "You must specify a course name.";
1555 } 1636 }
… …
1581 $import_courseID, 1662 $import_courseID,
1582 ); 1663 );
1583 1664
1584 my $db2 = new WeBWorK::DB($ce2->{dbLayout}); 1665 my $db2 = new WeBWorK::DB($ce2->{dbLayout});
1585 1666
1667 # locate file
1668 my $templateDir = $ce->{courseDirs}->{templates};
1669 my $filePath = "$templateDir/$import_file";
1670
1671 my $gunzipMessage = system( 'gunzip', $filePath);
1672 #FIXME
1673 #warn "gunzip ", $gunzipMessage;
1674 $filePath =~ s/\.gz$//;
1675 #warn "new file path is $filePath";
1676 my $fileHandle = new IO::File("<$filePath");
1586 # retrieve upload from upload cache 1677 # retrieve upload from upload cache
1587 my ($id, $hash) = split /\s+/, $import_file; 1678# my ($id, $hash) = split /\s+/, $import_file;
1588 my $upload = WeBWorK::Upload->retrieve($id, $hash, 1679# my $upload = WeBWorK::Upload->retrieve($id, $hash,
1589 dir => $ce->{webworkDirs}->{uploadCache} 1680# dir => $ce->{webworkDirs}->{uploadCache}
1590 ); 1681# );
1591 1682
1592 my @errors; 1683 my @errors;
1593 1684
1594 eval { 1685 eval {
1595 @errors = dbImport( 1686 @errors = dbImport(
1596 db => $db2, 1687 db => $db2,
1597 xml => $upload->fileHandle, 1688 # xml => $upload->fileHandle,
1689 xml => $fileHandle,
1598 tables => \@import_tables, 1690 tables => \@import_tables,
1599 conflict => $import_conflict, 1691 conflict => $import_conflict,
1600 ); 1692 );
1601 }; 1693 };
1602 1694
1603 $upload->dispose;
1604
1605 push @errors, "Fatal exception: $@" if $@; 1695 push @errors, "Fatal exception: $@" if $@;
1696 push @errors, $gunzipMessage if $gunzipMessage;
1606 1697
1607 if (@errors) { 1698 if (@errors) {
1608 print CGI::div({class=>"ResultsWithError"}, 1699 print CGI::div({class=>"ResultsWithError"},
1609 CGI::p("An error occured while importing the database of course $import_courseID:"), 1700 CGI::p("An error occured while importing the database of course $import_courseID:"),
1610 CGI::ul(CGI::li(\@errors)), 1701 CGI::ul(CGI::li(\@errors)),
Legend:
Removed from v.3059  
changed lines
  Added in v.3235
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9