View of /trunk/webwork/system/cgi/cgi-scripts/profHousekeeping.pl

    1 #!/usr/bin/perl
    2 
    3 
    4 ## This file is profHousekeeping.pl
    5 ## It provides access to utilities deleting uneeded files, etc.
    6 ##
    7 
    8 ####################################################################
    9 # Copyright @ 1995-1999 University of Rochester
   10 # All Rights Reserved
   11 ####################################################################
   12 
   13 use lib '/ww/webwork/development/'; # mainWeBWorKDirectory;
   14 use CGI qw(:standard);
   15 use Global;
   16 use Auth;
   17 use strict;
   18 
   19 # begin Timing code
   20 use Benchmark;
   21 my $beginTime = new Benchmark;
   22 # end Timing code
   23 
   24 my $cgi = new CGI;
   25 my %inputs = $cgi->Vars();
   26 
   27 # get information from CGI inputs  (see also below for additional information)
   28 
   29 my $Course    = $inputs{'course'};
   30 my $User    = $inputs{'user'};
   31 my $Session_key   = $inputs{'key'};
   32 
   33 # verify that information has been received
   34   unless($Course && $User && $Session_key) {
   35     &wwerror("$0","The script did not receive the proper input data.","","");
   36     die "The script profLogin.pl did not receive the proper input data.";
   37     }
   38 
   39 # establish environment for this script
   40 
   41 &Global::getCourseEnvironment($inputs{'course'});
   42 
   43 
   44 my $cgiURL        = getWebworkCgiURL;
   45 my $courseDirectory   = $Global::coursesDirectory . $Course . $Global::dirDelim;
   46 my $courseScriptsDirectory  = getCourseScriptsDirectory;
   47 my $databaseDirectory     = getCourseDatabaseDirectory;
   48 my $htmlURL           = getCourseHtmlURL;
   49 my $scriptDirectory       = getWebworkScriptDirectory;
   50 my $templateDirectory           = getCourseTemplateDirectory;
   51 my $dat                       = getDat;
   52 
   53 require "${scriptDirectory}$Global::DBglue_pl";
   54 require "${scriptDirectory}$Global::FILE_pl";
   55 require "${scriptDirectory}$Global::HTMLglue_pl";
   56 
   57 # log access
   58   &Global::log_info('', query_string);
   59 
   60 
   61   my $permissionsFile = &Global::getCoursePermissionsFile($Course);
   62   my $permissions = &get_permissions($User, $permissionsFile);
   63   my $keyFile = &Global::getCourseKeyFile($Course);
   64 
   65 #verify session key
   66   &verify_key($User, $Session_key, $keyFile, $Course);
   67 
   68 # verify permissions are correct
   69   if ($permissions != $Global::instructor_permissions ) {
   70       print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n";
   71       print &html_NO_PERMISSION;
   72       exit(0);
   73       }
   74 # get the rest of the information from the submitted form
   75   # nothing further to get in this case
   76 
   77 # print HTML text
   78 print &htmlTOP("Housekeeping Utilities");
   79 
   80 # print navigation button
   81 print $cgi->a( { -href=>"${cgiURL}login.pl?user=$User&key=$Session_key&course=$Course" },
   82 
   83                         $cgi->img({ -name=>'upImg',
   84                                           -src=>"${Global::upImgUrl}",
   85                                           -align=>'right',
   86                                           -border=>'1',
   87                                           -alt=>'[Up]'
   88                                         })
   89                         ),
   90         $cgi->p;
   91 
   92 print "\n",
   93         $cgi->hr, $cgi->br,
   94         "\n\n", $cgi->h3({ -align=>'left' }, "WeBWorK Housekeeping Utilities for $Course"), "\n",
   95         $cgi->p,
   96   "From this page, you can recover disk space by removing old tmp files,
   97   compress the gdbm database, show active users, edit the Course Environment file, etc.";
   98 
   99 # remove tmp files
  100 print heading('Cleanup', "1. Cleanup $Course:"),
  101   $cgi->startform(-action=>"${cgiURL}profRemoveTmpFiles.pl"),
  102   $cgi->submit(-value=>'Remove unnecessary tmp files'), "\n",
  103   hiddens('user', 'key', 'course'),
  104   $cgi->endform(), "\n",
  105   $cgi->p, "This removes unnecessary temporary fiels and may recover quite a bit of disk space.";
  106 
  107 
  108 # compress database
  109 print heading('Compress', "2. Compress the webworkdatabase for $Course:"),
  110   $cgi->startform(-action=>"${cgiURL}profCompress_GDBM_webwork-database.pl"),
  111   $cgi->submit(-value=>'Compress gdbm database'), "\n",
  112   hiddens('user', 'key', 'course'),
  113   $cgi->endform(), "\n",
  114   $cgi->p, "If $Course uses the gdbm database, this should be run monthly to significantly reduce the size of the database file.  if $Course does not use the gdbm database, the operation will abort and nothing will be done.";
  115 
  116 # active users
  117 print heading('Active', "3. Show active users in $Course:"),
  118   $cgi->startform(-action=>"${cgiURL}profShowActiveUsers.pl"),
  119   $cgi->submit(-value=>'Show Active Users'), "\n",
  120   hiddens('user', 'key', 'course'),
  121   $cgi->endform(), "\n",
  122   $cgi->p, "This lists all users who are currently logged into $Course.";
  123 
  124 # webworkcourse.ph
  125 my $filename = "${courseDirectory}$Global::courseEnvironmentFile";
  126 my ($date, $label, @stat);
  127 if (-e $filename) {
  128   @stat = stat($filename);
  129   $date = $stat[9];
  130   $date = formatDateAndTime($date);
  131   $date =~ s|\s*at.*||;
  132   $label = "  Last Changed $date";
  133 }
  134 
  135 print heading('Environment', "4. Edit Course Environment File for $Course:"),
  136   $cgi->startform(-action=>"${cgiURL}profEditCourseFiles.pl"),
  137   $cgi->submit(-value=>'Edit Course Environment File'), "$label\n",
  138   hiddens('user', 'key', 'course'),
  139   $cgi->hidden(-name=>'filename', -value=>$Global::courseEnvironmentFile), "\n",
  140   $cgi->hidden(-name=>'ext', -value=>'ph'), "\n",
  141   $cgi->endform(), "\n",
  142   $cgi->p, "This lets you edit the Course Environment File for $Course.";
  143 
  144 
  145 print &htmlBOTTOM("profHousekeeping.pl", \%inputs);
  146 
  147 # begin Timing code
  148 my $endTime = new Benchmark;
  149 &Global::logTimingInfo($beginTime,$endTime,"profHousekeeping.pl",$inputs{'course'},$inputs{'user'});
  150 # end Timing code
  151 exit;
  152 
  153 ################################################################################
  154 #
  155 # HELPFUL METHODS
  156 #
  157 ################################################################################
  158 
  159 #returns the horizontal line, blue square, and heading for each option
  160 #in the list, eliminating the need to repeat this code each time it is needed
  161 #this does NOT PRINT the info, so that it can be incorporated into other text
  162 sub heading {
  163         my $link = shift; #name for internal link (used for shortcuts on some pages)
  164         my $text = shift; #text used as the main heading
  165 
  166         return "\n",
  167                  $cgi->p, "\n",
  168                  $cgi->a({-name=>$link}), "\n",
  169                  $cgi->hr({ -noshade=>undef }), "\n",
  170                  $cgi->h4({ -align=>'LEFT' },
  171                                 "\n" . $cgi->img({-src=>"$Global::bluesquareImgUrl", -border=>1, -alt=>'' }) . "\n" .
  172                                 $text ), "\n";
  173 }
  174 
  175 #prints hidden form fields for each of given cgi parameters
  176 #if a given parameter does not exist, a note is placed in the html to that affect
  177 #this does NOT PRINT the info, so that it can be incorporated into other text
  178 sub hiddens {
  179   my @params = @_;
  180   my $out;
  181 
  182   foreach my $param (@params) {
  183     if (exists $inputs{$param}) {
  184       $out .= $cgi->hidden(-name=>"$param", -value=>"$inputs{$param}") . "\n";
  185     } else {
  186       $out .= $cgi->p . "\nExpected cgi parameter $param does not exist or is empty";
  187     }
  188   }
  189 
  190   $out;
  191 }