Parent Directory
| 
Revision Log
Revision 2 - (view) (download) (as text)
| 1 : | sam | 2 | #!/usr/bin/perl |
| 2 : | |||
| 3 : | #################################################################### | ||
| 4 : | # Copyright @ 1995-1999 University of Rochester | ||
| 5 : | # All Rights Reserved | ||
| 6 : | #################################################################### | ||
| 7 : | |||
| 8 : | use lib '/ww/webwork/development/'; # mainWeBWorKDirectory; | ||
| 9 : | |||
| 10 : | use CGI qw(:standard); | ||
| 11 : | use Global; | ||
| 12 : | use Auth; | ||
| 13 : | use strict; | ||
| 14 : | use GDBM_File; | ||
| 15 : | |||
| 16 : | # begin Timing code | ||
| 17 : | use Benchmark; | ||
| 18 : | my $beginTime = new Benchmark; | ||
| 19 : | # end Timing code | ||
| 20 : | |||
| 21 : | &CGI::ReadParse; | ||
| 22 : | my %inputs =%main::in; | ||
| 23 : | |||
| 24 : | # get information from CGI inputs (see also below for additional information) | ||
| 25 : | |||
| 26 : | my $Course = $inputs{'course'}; | ||
| 27 : | my $User = $inputs{'user'}; | ||
| 28 : | my $Session_key = $inputs{'key'}; | ||
| 29 : | |||
| 30 : | |||
| 31 : | # verify that information has been received | ||
| 32 : | unless($Course && $User && $Session_key) { | ||
| 33 : | &wwerror("$0","The script did not receive the proper input data.","",""); | ||
| 34 : | } | ||
| 35 : | |||
| 36 : | |||
| 37 : | # establish environment for this script | ||
| 38 : | |||
| 39 : | &Global::getCourseEnvironment($inputs{'course'}); | ||
| 40 : | |||
| 41 : | my $cgiURL = getWebworkCgiURL; | ||
| 42 : | my $scriptDirectory = getWebworkScriptDirectory; | ||
| 43 : | require "${scriptDirectory}$Global::HTMLglue_pl"; | ||
| 44 : | |||
| 45 : | # log access | ||
| 46 : | &Global::log_info('', query_string); | ||
| 47 : | |||
| 48 : | |||
| 49 : | my $permissionsFile = &Global::getCoursePermissionsFile($inputs{'course'}); | ||
| 50 : | my $permissions = &get_permissions($inputs{'user'}, $permissionsFile); | ||
| 51 : | my $keyFile = &Global::getCourseKeyFile($inputs{'course'}); | ||
| 52 : | |||
| 53 : | |||
| 54 : | #verify session key | ||
| 55 : | &verify_key($inputs{'user'}, $inputs{'key'}, $keyFile, $inputs{'course'}); | ||
| 56 : | |||
| 57 : | # verify permissions are correct | ||
| 58 : | if ($permissions != $Global::instructor_permissions ) { | ||
| 59 : | print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n"; | ||
| 60 : | print &html_NO_PERMISSION; | ||
| 61 : | exit(0); | ||
| 62 : | } | ||
| 63 : | # Directory paths | ||
| 64 : | |||
| 65 : | my $databaseDirectory = getCourseDatabaseDirectory(); | ||
| 66 : | my $databaseFile = $Global::database; | ||
| 67 : | |||
| 68 : | ## exit unless the course uses gdbm for the webwork database | ||
| 69 : | unless ($Global::DBtie_file eq 'gdbm_tie.pl') { | ||
| 70 : | wwerror("Wrong database type", "Compress works only for gdbm databases. No changes | ||
| 71 : | have been made to your non gdbm database"); | ||
| 72 : | } | ||
| 73 : | |||
| 74 : | |||
| 75 : | |||
| 76 : | my $mode = &GDBM_WRCREAT(); | ||
| 77 : | my $permission = $Global::standard_tie_permission; | ||
| 78 : | my ($db, %hash, $tries); | ||
| 79 : | my $TieMaxTries =30; # try to tie() 30 times, then fail | ||
| 80 : | my $TieSleepInterval =2; # sleep 2 sec after failed tie() | ||
| 81 : | |||
| 82 : | &tie_hash(); | ||
| 83 : | $db->reorganize(); | ||
| 84 : | untie($db); | ||
| 85 : | chmod($permission,"${databaseDirectory}${databaseFile}") or | ||
| 86 : | warn("$0 error", " Can't do chmod($permission, ${databaseDirectory}${databaseFile})"); | ||
| 87 : | chown(-1,$Global::numericalGroupID,"${databaseDirectory}${databaseFile}") or | ||
| 88 : | warn("$0 error", " Can't do chown(-1,$Global::numericalGroupID,${databaseDirectory}${databaseFile})"); | ||
| 89 : | &compressSuccess(); | ||
| 90 : | |||
| 91 : | |||
| 92 : | sub tie_hash { | ||
| 93 : | for ($tries = 0; $tries < $TieMaxTries; $tries++) { | ||
| 94 : | return 1 if ($db = tie(%hash, "GDBM_File", "${databaseDirectory}${databaseFile}", $mode, $permission)); | ||
| 95 : | sleep($TieSleepInterval); | ||
| 96 : | } | ||
| 97 : | &wwerror("Key database error", "Can't tie ${databaseDirectory}${databaseFile}: $!"); | ||
| 98 : | } | ||
| 99 : | |||
| 100 : | |||
| 101 : | sub compressSuccess { | ||
| 102 : | |||
| 103 : | print"content-type:\n\n<H2>Success, ${databaseDirectory}${databaseFile} compressed. </H2>\n"; | ||
| 104 : | print "The WeBWorK database file ${databaseDirectory}${databaseFile} has been compressed"; | ||
| 105 : | |||
| 106 : | print "<FORM METHOD=POST ACTION=\"${cgiURL}profLogin.pl\"><P>"; | ||
| 107 : | print &sessionKeyInputs(\%inputs); | ||
| 108 : | print <<"ENDOFHTML"; | ||
| 109 : | <INPUT TYPE=SUBMIT VALUE="Return to Prof Page"> | ||
| 110 : | </FORM> | ||
| 111 : | ENDOFHTML | ||
| 112 : | print &htmlBOTTOM("profCompress_GDBM_webwork-database.pl", \%inputs); | ||
| 113 : | } | ||
| 114 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |