Parent Directory
| 
Revision Log
Revision 10 - (view) (download) (as text)
| 1 : | sam | 10 | #!/usr/local/bin/perl |
| 2 : | sam | 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 : | gage | 8 | use lib '.'; use webworkInit; # WeBWorKInitLine |
| 14 : | sam | 2 | 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 : | } |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |