Return to quotacheck.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Disk usage displayed in MB.

    1: #!/usr/bin/perl
    2: $|=1;
    3: # Display quotas for uploaded course content, current disk usage and
    4: # percent usage for courses and communities for requested domain.
    5: # Requester should either be an active domain coordinator in 
    6: # requested domain, or current server should belong to requested
    7: # domain.
    8: #
    9: # $Id: quotacheck.pl,v 1.2 2014/06/13 18:50:07 raeburn Exp $
   10: #
   11: # Copyright Michigan State University Board of Trustees
   12: #
   13: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   14: #
   15: # LON-CAPA is free software; you can redistribute it and/or modify
   16: # it under the terms of the GNU General Public License as published by
   17: # the Free Software Foundation; either version 2 of the License, or
   18: # (at your option) any later version.
   19: #
   20: # LON-CAPA is distributed in the hope that it will be useful,
   21: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   22: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   23: # GNU General Public License for more details.
   24: #
   25: # You should have received a copy of the GNU General Public License
   26: # along with LON-CAPA; if not, write to the Free Software
   27: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   28: #
   29: # /home/httpd/html/adm/gpl.txt
   30: #
   31: # http://www.lon-capa.org/
   32: #
   33: 
   34: use strict;
   35: 
   36: use lib '/home/httpd/lib/perl/';
   37: use Apache::lonnet();
   38: use Apache::loncommon();
   39: use Apache::lonlocal();
   40: use LONCAPA::Configuration();
   41: use LONCAPA::loncgi();
   42: use LONCAPA::lonauthcgi();
   43: use File::Find;
   44: use CGI qw(:standard);
   45: use LONCAPA;
   46: 
   47: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
   48: my $lonhost;
   49: if (ref($perlvar) eq 'HASH') {
   50:     $lonhost = $perlvar->{'lonHostID'};
   51: }
   52: undef($perlvar);
   53: 
   54: print &LONCAPA::loncgi::cgi_header('text/html',1);
   55: &main($lonhost);
   56: 
   57: sub main {
   58:     my ($lonhost) = @_;
   59:     if ($lonhost eq '') {
   60:         &Apache::lonlocal::get_language_handle();
   61:         &Apache::lonhtmlcommon::add_breadcrumb
   62:         ({href=>"/cgi-bin/quotacheck.pl",
   63:           text=>"Content disk usage"});
   64:         print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
   65:               &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
   66:               '<p class="LC_error">'.
   67:               &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
   68:               '</p>'
   69:               &Apache::loncommon::end_page());
   70:         return;
   71:     }
   72:     if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
   73:         &LONCAPA::loncgi::check_cookie_and_load_env();
   74:     } else {
   75:         if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
   76:             &Apache::lonlocal::get_language_handle();
   77:             print(&LONCAPA::loncgi::missing_cookie_msg());
   78:             return;
   79:         }
   80:         if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
   81:             &Apache::lonlocal::get_language_handle();
   82:             print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
   83:             return;
   84:         }
   85:     }
   86:     my (%gets,%posted,$reqdom,$crstype,%params);
   87: 
   88: #
   89: #  Get domain -- if this is for an authenticated user (i.e., not IP-based access)
   90: #  Set domain in the order (a) value of fixeddom form element, if submitted
   91: #                          (b) value of domain item in query string
   92: #                          (c) default login domain for current server   
   93: #
   94: 
   95:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
   96:         my $q = CGI->new;
   97:         %params = $q->Vars;
   98:         $crstype = 'Course';
   99:         if ($params{'type'} eq 'Community') {
  100:             $crstype = $params{'type'};
  101:         }
  102:         if ($params{'fixeddom'}) {
  103:             $reqdom = $params{'fixeddom'};
  104:         }
  105:     }
  106:     if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
  107:         &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
  108:         if (ref($gets{'domain'}) eq 'ARRAY') {
  109:             $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
  110:             if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
  111:                 my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
  112:                 unless ($domdesc eq '') {
  113:                     $reqdom = $gets{'domain'}->[0];
  114:                 }
  115:             }
  116:         }
  117:     }
  118:     if ($reqdom eq '') {
  119:         $reqdom = &Apache::lonnet::default_login_domain();
  120:     }
  121: 
  122:     &Apache::lonlocal::get_language_handle();
  123:     &Apache::lonhtmlcommon::add_breadcrumb
  124:     ({href=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
  125:        text=>"Content disk usage"});
  126:     if ($params{'gosearch'}) {
  127:         &Apache::lonhtmlcommon::add_breadcrumb
  128:             ({href=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
  129:               text=>"Result"});
  130:     }
  131:     my $domdesc = &Apache::lonnet::domain($reqdom,'description');
  132:     print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
  133:           &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
  134:           '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
  135:           '<h3>'.$domdesc.'</h3>');
  136: 
  137: #
  138: #  If this is for an authenticated user (i.e., not IP-based access)
  139: #  create display to choose filters to restrict courses/communities displayed
  140: #  (e.g., recent activity, recently created, institutional code, course owner etc.)
  141: #
  142: 
  143:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
  144:         my ($numtitles,@codetitles);
  145:         print(&Apache::loncommon::js_changer());
  146:         my ($filterlist,$filter) = &get_filters($reqdom,\%params);
  147:         $Apache::lonnet::env{'form.official'} = $params{'official'};
  148:         if ($params{'official'}) {
  149:             my @standardnames = &Apache::loncommon::get_standard_codeitems();
  150:             pop(@standardnames);
  151:             foreach my $item (@standardnames) {
  152:                 if ($params{'official'} eq 'on') {
  153:                     $Apache::lonnet::env{'form.'.$item} = $params{$item};
  154:                 } else {
  155:                     $Apache::lonnet::env{'form.'.$item} = 0;
  156:                 }
  157:             }
  158:             $Apache::lonnet::env{'form.state'} = $params{'state'};
  159:         }
  160:         print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
  161:                                                 '/cgi-bin/quotacheck.pl',\$numtitles,
  162:                                                 'quotacheck',undef,undef,undef,
  163:                                                 \@codetitles,$reqdom,'quotacheck',$reqdom));
  164:         if ($params{'gosearch'}) {
  165:             if ($params{'official'} eq 'on') {
  166:                 $Apache::lonnet::env{'form.state'} = $params{'state'};
  167:             }
  168:             my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
  169:                                                              undef,undef,undef,\@codetitles);
  170:             my @showcourses = keys(%courses);
  171:             &print_usage($lonhost,$reqdom,\@showcourses);
  172:         }
  173:         print(&Apache::loncommon::end_page());
  174:         return;
  175:     }
  176:     &print_usage($lonhost,$reqdom);
  177:     print(&Apache::loncommon::end_page());
  178:     return;
  179: }
  180: 
  181: sub print_usage {
  182:     my ($lonhost,$dom,$courses) = @_;
  183:     my @domains = &Apache::lonnet::current_machine_domains();
  184:     my @ids=&Apache::lonnet::current_machine_ids();
  185:     my $domain = &Apache::lonnet::host_domain($lonhost);
  186: 
  187: #
  188: # If user's current role is domain coordinator, domain of courses/communities
  189: # to be shown needs to be domain being coordinated. 
  190: #
  191:     if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
  192:         $domain = $Apache::lonnet::env{'request.role.domain'};
  193:         unless ($dom eq $domain) {
  194:             my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
  195:             print('<p class="LC_error">'.
  196:                   &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
  197:                   '</p>'."\n".
  198:                   '<p class="LC_info">'.
  199:                   &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
  200:                                         '<a href="/cgi-bin/quotacheck.pl?domain='.$domain.'">'.
  201:                                         $otherdomdesc.'</a>').
  202:                   '</p>');
  203:             return;
  204:         }
  205:     } else {
  206:         unless (grep(/^\Q$dom\E/,@domains)) {
  207:             print('<p class="LC_error">'.
  208:                   &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
  209:                   '</p>');
  210:             return;
  211:         }
  212:     }
  213:     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
  214:     my @showcourses;
  215:     if (ref($courses) eq 'ARRAY') {
  216:         @showcourses = @{$courses};
  217:     } else {
  218:         my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
  219:         if (keys(%courseshash)) {
  220:             @showcourses = keys(%courseshash);
  221:         }
  222:     }
  223:     if (@showcourses) {
  224:         print(&Apache::loncommon::start_data_table().
  225:               &Apache::loncommon::start_data_table_header_row().
  226:               '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
  227:               '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
  228:               '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
  229:               '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
  230:               '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
  231:               '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
  232:               &Apache::loncommon::end_data_table_header_row());
  233:         foreach my $cid (@showcourses) {
  234:             my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
  235:             my $cdesc = $courseinfo{'description'};
  236:             my $cnum = $courseinfo{'num'};
  237:             my $chome = $courseinfo{'home'};
  238:             my $crstype = $courseinfo{'type'};
  239:             if ($crstype eq '') {
  240:                 if ($cnum =~ /^$LONCAPA::match_community$/) {
  241:                     $crstype = 'Community';
  242:                 } else {
  243:                     $crstype = 'Course';
  244:                 }
  245:             }
  246:             my $instcode = $courseinfo{'internal.coursecode'};
  247:             my $quota = $courseinfo{'internal.uploadquota'};
  248:             $quota =~ s/[^\d\.]+//g;
  249:             my $quotatype = 'unofficial';
  250:             if ($crstype eq 'Community') {
  251:                 $quotatype = 'community';
  252:             } elsif ($courseinfo{'internal.coursecode'}) {
  253:                 $quotatype = 'official';
  254:             } elsif ($courseinfo{'internal.textbook'}) {
  255:                 $quotatype = 'textbook';
  256:             }
  257:             if ($quota eq '') {
  258:                 $quota = $domdefs{$crstype.'quota'};
  259:             }
  260:             $quota =~ s/[^\d\.]+//g;
  261:             if ($quota eq '') {
  262:                 $quota = 500;
  263:             }
  264:             my $current_disk_usage = 0;
  265:             if (grep(/^\Q$chome\E$/,@ids)) {
  266:                 my $dir = &propath($dom,$cnum).'/userfiles/';
  267:                 foreach my $subdir ('docs','supplemental') {
  268:                     my $ududir = "$dir/$subdir";
  269:                     my $total_size=0;
  270:                     my $code=sub {
  271:                         if (-d $_) { return;}
  272:                         $total_size+=(stat($_))[7];
  273:                     };
  274:                     chdir($ududir);
  275:                     find($code,$ududir);
  276:                     $total_size=int($total_size/(1024*1024));
  277:                     $current_disk_usage += $total_size;
  278:                 }
  279:             } else {
  280:                 foreach my $subdir ('docs','supplemental') {
  281:                     $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
  282:                 }
  283:                 $current_disk_usage=int($current_disk_usage/1024);
  284:             }
  285:             my $percent;
  286:             if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
  287:                 $percent = 100.0;
  288:             } else {
  289:                 $percent = 100*($current_disk_usage/$quota);
  290:             }
  291:             $current_disk_usage = sprintf("%.0f",$current_disk_usage);
  292:             $quota = sprintf("%.0f",$quota);
  293:             $percent = sprintf("%.0f",$percent);
  294:             print(&Apache::loncommon::start_data_table_row().
  295:                   '<td>'.$quotatype.'</td>'.
  296:                   '<td>'.$cdesc.'</td>'.
  297:                   '<td>'.$instcode.'</td>'.
  298:                   '<td>'.$quota.'</td>'.
  299:                   '<td>'.$current_disk_usage.'</td>'.
  300:                   '<td>'.$percent.'</td>'.
  301:                    &Apache::loncommon::end_data_table_row()
  302:                   );
  303:         }
  304:         print(&Apache::loncommon::end_data_table().'<br /><br />');
  305:     } else {
  306:         print(&Apache::lonlocal::mt('No courses match search criteria.'));
  307:     }
  308:     return;
  309: }
  310: 
  311: sub get_filters {
  312:     my ($dom,$params) = @_;
  313:     my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
  314:                       'ownerdomfilter','coursefilter','sincefilter');
  315:     # created filter
  316:     my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
  317:     if ($loncaparev ne 'unknown_cmd') {
  318:         push(@filterlist,'createdfilter');
  319:     }
  320:     my %filter;
  321:     foreach my $item (@filterlist) {
  322:         $filter{$item} = '';
  323:     }
  324:     if (ref($params) eq 'HASH') {
  325:         foreach my $item (@filterlist) {
  326:             $filter{$item} = $params->{$item};
  327:         }
  328:     }
  329:     return (\@filterlist,\%filter);
  330: }
  331: