File:  [LON-CAPA] / loncom / cgi / quotacheck.pl
Revision 1.4: download - view: text, annotated - select for diffs
Thu Jul 31 15:45:31 2014 UTC (9 years, 11 months ago) by musolffc
Branches: MAIN
CVS tags: HEAD
Making drop-down selections persistent after search

    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.4 2014/07/31 15:45:31 musolffc 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: my $script = "/cgi-bin/quotacheck.pl";
   55: 
   56: print &LONCAPA::loncgi::cgi_header('text/html',1);
   57: &main($lonhost);
   58: 
   59: sub main {
   60:     my ($lonhost) = @_;
   61:     if ($lonhost eq '') {
   62:         &Apache::lonlocal::get_language_handle();
   63:         &Apache::lonhtmlcommon::add_breadcrumb
   64:         ({href=>$script,
   65:           text=>"Content disk usage"});
   66:         print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
   67:               &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
   68:               '<p class="LC_error">'.
   69:               &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
   70:               '</p>'
   71:               &Apache::loncommon::end_page());
   72:         return;
   73:     }
   74:     if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
   75:         &LONCAPA::loncgi::check_cookie_and_load_env();
   76:     } else {
   77:         if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
   78:             &Apache::lonlocal::get_language_handle();
   79:             print(&LONCAPA::loncgi::missing_cookie_msg());
   80:             return;
   81:         }
   82:         if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
   83:             &Apache::lonlocal::get_language_handle();
   84:             print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
   85:             return;
   86:         }
   87:     }
   88:     my (%gets,%posted,$reqdom,$crstype,%params);
   89: 
   90: #
   91: #  Get domain -- if this is for an authenticated user (i.e., not IP-based access)
   92: #  Set domain in the order (a) value of fixeddom form element, if submitted
   93: #                          (b) value of domain item in query string
   94: #                          (c) default login domain for current server   
   95: #
   96: 
   97:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
   98:         my $q = CGI->new;
   99:         %params = $q->Vars;
  100:         $crstype = 'Course';
  101:         if ($params{'type'} eq 'Community') {
  102:             $crstype = $params{'type'};
  103:         }
  104:         if ($params{'fixeddom'}) {
  105:             $reqdom = $params{'fixeddom'};
  106:         }
  107:     }
  108:     if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
  109:         &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
  110:         if (ref($gets{'domain'}) eq 'ARRAY') {
  111:             $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
  112:             if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
  113:                 my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
  114:                 unless ($domdesc eq '') {
  115:                     $reqdom = $gets{'domain'}->[0];
  116:                 }
  117:             }
  118:         }
  119:     }
  120:     if ($reqdom eq '') {
  121:         $reqdom = &Apache::lonnet::default_login_domain();
  122:     }
  123: 
  124:     &Apache::lonlocal::get_language_handle();
  125:     &Apache::lonhtmlcommon::add_breadcrumb
  126:     ({href=>$script."?domain=$reqdom",
  127:        text=>"Content disk usage"});
  128:     if ($params{'gosearch'}) {
  129:         &Apache::lonhtmlcommon::add_breadcrumb
  130:             ({href=>$script."?domain=$reqdom",
  131:               text=>"Result"});
  132:     }
  133:     my $domdesc = &Apache::lonnet::domain($reqdom,'description');
  134:     my $starthash = {
  135:         add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
  136:     };
  137:     print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
  138:           &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
  139:           '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
  140:           '<h3>'.$domdesc.'</h3>');
  141: 
  142: #
  143: #  If this is for an authenticated user (i.e., not IP-based access)
  144: #  create display to choose filters to restrict courses/communities displayed
  145: #  (e.g., recent activity, recently created, institutional code, course owner etc.)
  146: #
  147: 
  148:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
  149:         my ($numtitles,@codetitles);
  150:         print(&Apache::loncommon::js_changer());
  151:         my ($filterlist,$filter) = &get_filters($reqdom,\%params);
  152:         $Apache::lonnet::env{'form.official'} = $params{'official'};
  153:         if ($params{'official'}) {
  154:             my @standardnames = &Apache::loncommon::get_standard_codeitems();
  155:             pop(@standardnames);
  156:             foreach my $item (@standardnames) {
  157:                 if ($params{'official'} eq 'on') {
  158:                     $Apache::lonnet::env{'form.'.$item} = $params{$item};
  159:                 } else {
  160:                     $Apache::lonnet::env{'form.'.$item} = 0;
  161:                 }
  162:             }
  163:             $Apache::lonnet::env{'form.state'} = $params{'state'};
  164:         }
  165:         print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
  166:                                                 $script,\$numtitles,
  167:                                                 'quotacheck',undef,undef,undef,
  168:                                                 \@codetitles,$reqdom,'quotacheck',$reqdom));
  169:         if ($params{'gosearch'}) {
  170:             if ($params{'official'} eq 'on') {
  171:                 $Apache::lonnet::env{'form.state'} = $params{'state'};
  172:             }
  173:             my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
  174:                                                              undef,undef,undef,\@codetitles);
  175:             my @showcourses = keys(%courses);
  176:             &print_usage($lonhost,$reqdom,\@showcourses);
  177:         }
  178:         print(&Apache::loncommon::end_page());
  179:         return;
  180:     }
  181:     &print_usage($lonhost,$reqdom);
  182:     print(&Apache::loncommon::end_page());
  183:     return;
  184: }
  185: 
  186: sub print_usage {
  187:     my ($lonhost,$dom,$courses) = @_;
  188:     my @domains = &Apache::lonnet::current_machine_domains();
  189:     my @ids=&Apache::lonnet::current_machine_ids();
  190:     my $domain = &Apache::lonnet::host_domain($lonhost);
  191: 
  192: #
  193: # If user's current role is domain coordinator, domain of courses/communities
  194: # to be shown needs to be domain being coordinated. 
  195: #
  196:     if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
  197:         $domain = $Apache::lonnet::env{'request.role.domain'};
  198:         unless ($dom eq $domain) {
  199:             my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
  200:             print('<p class="LC_error">'.
  201:                   &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
  202:                   '</p>'."\n".
  203:                   '<p class="LC_info">'.
  204:                   &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
  205:                                         '<a href="'.$script.'?domain='.$domain.'">'.
  206:                                         $otherdomdesc.'</a>').
  207:                   '</p>');
  208:             return;
  209:         }
  210:     } else {
  211:         unless (grep(/^\Q$dom\E/,@domains)) {
  212:             print('<p class="LC_error">'.
  213:                   &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
  214:                   '</p>');
  215:             return;
  216:         }
  217:     }
  218:     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
  219:     my @showcourses;
  220:     if (ref($courses) eq 'ARRAY') {
  221:         @showcourses = @{$courses};
  222:     } else {
  223:         my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
  224:         if (keys(%courseshash)) {
  225:             @showcourses = keys(%courseshash);
  226:         }
  227:     }
  228:     if (@showcourses) {
  229:         print(&Apache::loncommon::start_data_table().
  230:               &Apache::loncommon::start_data_table_header_row().
  231:               '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
  232:               '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
  233:               '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
  234:               '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
  235:               '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
  236:               '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
  237:               &Apache::loncommon::end_data_table_header_row());
  238:         foreach my $cid (@showcourses) {
  239:             my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
  240:             my $cdesc = $courseinfo{'description'};
  241:             my $cnum = $courseinfo{'num'};
  242:             my $chome = $courseinfo{'home'};
  243:             my $crstype = $courseinfo{'type'};
  244:             if ($crstype eq '') {
  245:                 if ($cnum =~ /^$LONCAPA::match_community$/) {
  246:                     $crstype = 'Community';
  247:                 } else {
  248:                     $crstype = 'Course';
  249:                 }
  250:             }
  251:             my $instcode = $courseinfo{'internal.coursecode'};
  252:             my $quota = $courseinfo{'internal.uploadquota'};
  253:             $quota =~ s/[^\d\.]+//g;
  254:             my $quotatype = 'unofficial';
  255:             if ($crstype eq 'Community') {
  256:                 $quotatype = 'community';
  257:             } elsif ($courseinfo{'internal.coursecode'}) {
  258:                 $quotatype = 'official';
  259:             } elsif ($courseinfo{'internal.textbook'}) {
  260:                 $quotatype = 'textbook';
  261:             }
  262:             if ($quota eq '') {
  263:                 $quota = $domdefs{$crstype.'quota'};
  264:             }
  265:             $quota =~ s/[^\d\.]+//g;
  266:             if ($quota eq '') {
  267:                 $quota = 500;
  268:             }
  269:             my $current_disk_usage = 0;
  270:             if (grep(/^\Q$chome\E$/,@ids)) {
  271:                 my $dir = &propath($dom,$cnum).'/userfiles/';
  272:                 foreach my $subdir ('docs','supplemental') {
  273:                     my $ududir = "$dir/$subdir";
  274:                     my $total_size=0;
  275:                     my $code=sub {
  276:                         if (-d $_) { return;}
  277:                         $total_size+=(stat($_))[7];
  278:                     };
  279:                     chdir($ududir);
  280:                     find($code,$ududir);
  281:                     $total_size=int($total_size/(1024*1024));
  282:                     $current_disk_usage += $total_size;
  283:                 }
  284:             } else {
  285:                 foreach my $subdir ('docs','supplemental') {
  286:                     $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
  287:                 }
  288:                 $current_disk_usage=int($current_disk_usage/1024);
  289:             }
  290:             my $percent;
  291:             if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
  292:                 $percent = 100.0;
  293:             } else {
  294:                 $percent = 100*($current_disk_usage/$quota);
  295:             }
  296:             $current_disk_usage = sprintf("%.0f",$current_disk_usage);
  297:             $quota = sprintf("%.0f",$quota);
  298:             $percent = sprintf("%.0f",$percent);
  299:             print(&Apache::loncommon::start_data_table_row().
  300:                   '<td>'.$quotatype.'</td>'.
  301:                   '<td>'.$cdesc.'</td>'.
  302:                   '<td>'.$instcode.'</td>'.
  303:                   '<td>'.$quota.'</td>'.
  304:                   '<td>'.$current_disk_usage.'</td>'.
  305:                   '<td>'.$percent.'</td>'.
  306:                    &Apache::loncommon::end_data_table_row()
  307:                   );
  308:         }
  309:         print(&Apache::loncommon::end_data_table().'<br /><br />');
  310:     } else {
  311:         print(&Apache::lonlocal::mt('No courses match search criteria.'));
  312:     }
  313:     return;
  314: }
  315: 
  316: sub get_filters {
  317:     my ($dom,$params) = @_;
  318:     my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
  319:                       'ownerdomfilter','coursefilter','sincefilter');
  320:     # created filter
  321:     my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
  322:     if ($loncaparev ne 'unknown_cmd') {
  323:         push(@filterlist,'createdfilter');
  324:     }
  325:     my %filter;
  326:     foreach my $item (@filterlist) {
  327:         $filter{$item} = '';
  328:     }
  329:     if (ref($params) eq 'HASH') {
  330:         foreach my $item (@filterlist) {
  331:             $filter{$item} = $params->{$item};
  332:         }
  333:     }
  334:     return (\@filterlist,\%filter);
  335: }
  336: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>