View of /trunk/webwork/system/cgi/cgi-scripts/profCompress_GDBM_webwork-database.pl

    1 #!/usr/local/bin/webwork-perl
    2 
    3 ####################################################################
    4 # Copyright @ 1995-1999 University of Rochester
    5 # All Rights Reserved
    6 ####################################################################
    7 
    8 use lib '.'; use webworkInit; # WeBWorKInitLine
    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::FILE_pl";
   44 require "${scriptDirectory}$Global::HTMLglue_pl";
   45 
   46 # log access
   47 &Global::log_info('', query_string);
   48 
   49 
   50 my $permissionsFile = &Global::getCoursePermissionsFile($inputs{'course'});
   51 my $permissions = &get_permissions($inputs{'user'}, $permissionsFile);
   52 my $keyFile = &Global::getCourseKeyFile($inputs{'course'});
   53 
   54 
   55 #verify session key
   56 &verify_key($inputs{'user'}, $inputs{'key'}, $keyFile, $inputs{'course'});
   57 
   58 # verify permissions are correct
   59 if ($permissions != $Global::instructor_permissions ) {
   60     print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n";
   61     print &html_NO_PERMISSION;
   62     exit(0);
   63 }
   64 # Directory paths
   65 
   66 my $databaseDirectory = getCourseDatabaseDirectory();
   67 my $databaseFile = $Global::database;
   68 
   69             ## exit unless the course uses gdbm for the webwork database
   70 unless ($Global::DBtie_file eq 'gdbm_tie.pl') {
   71     wwerror("Wrong database type", "Compress works only for gdbm databases.  No changes
   72     have been made to your non gdbm database");
   73 }
   74 
   75 
   76 
   77 my $mode = &GDBM_WRCREAT();
   78 my $permission = $Global::standard_tie_permission;
   79 my ($db, %hash, $tries);
   80 my $TieMaxTries =30;  # try to tie() 30 times, then fail
   81 my $TieSleepInterval =2; # sleep 2 sec after failed tie()
   82 
   83 &tie_hash();
   84 $db->reorganize();
   85 untie($db);
   86 chmod($permission,"${databaseDirectory}${databaseFile}") or
   87           warn("$0 error", " Can't do chmod($permission, ${databaseDirectory}${databaseFile})");
   88 chown(-1,$Global::numericalGroupID,"${databaseDirectory}${databaseFile}") or
   89           warn("$0 error", " Can't do chown(-1,$Global::numericalGroupID,${databaseDirectory}${databaseFile})");
   90 
   91 
   92 &compressSuccess();
   93 exit;
   94 
   95 sub tie_hash {
   96     for ($tries = 0; $tries < $TieMaxTries; $tries++) {
   97         return 1 if ($db = tie(%hash, "GDBM_File", "${databaseDirectory}${databaseFile}", $mode, $permission));
   98         sleep($TieSleepInterval);
   99     }
  100     &wwerror("Key database error", "Can't tie ${databaseDirectory}${databaseFile}: $!");
  101 }
  102 
  103 
  104 sub compressSuccess {
  105 
  106   print"content-type:\n\n<H2>Success, ${databaseDirectory}${databaseFile} compressed. </H2>\n";
  107   print "The WeBWorK database file ${databaseDirectory}${databaseFile} has been compressed";
  108 
  109   print "<FORM METHOD=POST ACTION=\"${cgiURL}profLogin.pl\"><P>";
  110   print &sessionKeyInputs(\%inputs);
  111 print <<"ENDOFHTML";
  112 <INPUT TYPE=SUBMIT VALUE="Return to Prof Page">
  113 </FORM>
  114 ENDOFHTML
  115   print &htmlBOTTOM("profCompress_GDBM_webwork-database.pl", \%inputs);
  116 }
  117