Return to quotacheck.pl CVS log

Up to [LON-CAPA] / loncom / cgi

Defined string constant "$script" to clean up code

    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.3 2014/07/31 15:02:26 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:     print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
  135:           &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
  136:           '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
  137:           '<h3>'.$domdesc.'</h3>');
  138: 
  139: #
  140: #  If this is for an authenticated user (i.e., not IP-based access)
  141: #  create display to choose filters to restrict courses/communities displayed
  142: #  (e.g., recent activity, recently created, institutional code, course owner etc.)
  143: #
  144: 
  145:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
  146:         my ($numtitles,@codetitles);
  147:         print(&Apache::loncommon::js_changer());
  148:         my ($filterlist,$filter) = &get_filters($reqdom,\%params);
  149:         $Apache::lonnet::env{'form.official'} = $params{'official'};
  150:         if ($params{'official'}) {
  151:             my @standardnames = &Apache::loncommon::get_standard_codeitems();
  152:             pop(@standardnames);
  153:             foreach my $item (@standardnames) {
  154:                 if ($params{'official'} eq 'on') {
  155:                     $Apache::lonnet::env{'form.'.$item} = $params{$item};
  156:                 } else {
  157:                     $Apache::lonnet::env{'form.'.$item} = 0;
  158:                 }
  159:             }
  160:             $Apache::lonnet::env{'form.state'} = $params{'state'};
  161:         }
  162:         print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
  163:                                                 $script,\$numtitles,
  164:                                                 'quotacheck',undef,undef,undef,
  165:                                                 \@codetitles,$reqdom,'quotacheck',$reqdom));
  166:         if ($params{'gosearch'}) {
  167:             if ($params{'official'} eq 'on') {
  168:                 $Apache::lonnet::env{'form.state'} = $params{'state'};
  169:             }
  170:             my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
  171:                                                              undef,undef,undef,\@codetitles);
  172:             my @showcourses = keys(%courses);
  173:             &print_usage($lonhost,$reqdom,\@showcourses);
  174:         }
  175:         print(&Apache::loncommon::end_page());
  176:         return;
  177:     }
  178:     &print_usage($lonhost,$reqdom);
  179:     print(&Apache::loncommon::end_page());
  180:     return;
  181: }
  182: 
  183: sub print_usage {
  184:     my ($lonhost,$dom,$courses) = @_;
  185:     my @domains = &Apache::lonnet::current_machine_domains();
  186:     my @ids=&Apache::lonnet::current_machine_ids();
  187:     my $domain = &Apache::lonnet::host_domain($lonhost);
  188: 
  189: #
  190: # If user's current role is domain coordinator, domain of courses/communities
  191: # to be shown needs to be domain being coordinated. 
  192: #
  193:     if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
  194:         $domain = $Apache::lonnet::env{'request.role.domain'};
  195:         unless ($dom eq $domain) {
  196:             my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
  197:             print('<p class="LC_error">'.
  198:                   &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
  199:                   '</p>'."\n".
  200:                   '<p class="LC_info">'.
  201:                   &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
  202:                                         '<a href="'.$script.'?domain='.$domain.'">'.
  203:                                         $otherdomdesc.'</a>').
  204:                   '</p>');
  205:             return;
  206:         }
  207:     } else {
  208:         unless (grep(/^\Q$dom\E/,@domains)) {
  209:             print('<p class="LC_error">'.
  210:                   &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
  211:                   '</p>');
  212:             return;
  213:         }
  214:     }
  215:     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
  216:     my @showcourses;
  217:     if (ref($courses) eq 'ARRAY') {
  218:         @showcourses = @{$courses};
  219:     } else {
  220:         my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
  221:         if (keys(%courseshash)) {
  222:             @showcourses = keys(%courseshash);
  223:         }
  224:     }
  225:     if (@showcourses) {
  226:         print(&Apache::loncommon::start_data_table().
  227:               &Apache::loncommon::start_data_table_header_row().
  228:               '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
  229:               '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
  230:               '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
  231:               '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
  232:               '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
  233:               '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
  234:               &Apache::loncommon::end_data_table_header_row());
  235:         foreach my $cid (@showcourses) {
  236:             my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
  237:             my $cdesc = $courseinfo{'description'};
  238:             my $cnum = $courseinfo{'num'};
  239:             my $chome = $courseinfo{'home'};
  240:             my $crstype = $courseinfo{'type'};
  241:             if ($crstype eq '') {
  242:                 if ($cnum =~ /^$LONCAPA::match_community$/) {
  243:                     $crstype = 'Community';
  244:                 } else {
  245:                     $crstype = 'Course';
  246:                 }
  247:             }
  248:             my $instcode = $courseinfo{'internal.coursecode'};
  249:             my $quota = $courseinfo{'internal.uploadquota'};
  250:             $quota =~ s/[^\d\.]+//g;
  251:             my $quotatype = 'unofficial';
  252:             if ($crstype eq 'Community') {
  253:                 $quotatype = 'community';
  254:             } elsif ($courseinfo{'internal.coursecode'}) {
  255:                 $quotatype = 'official';
  256:             } elsif ($courseinfo{'internal.textbook'}) {
  257:                 $quotatype = 'textbook';
  258:             }
  259:             if ($quota eq '') {
  260:                 $quota = $domdefs{$crstype.'quota'};
  261:             }
  262:             $quota =~ s/[^\d\.]+//g;
  263:             if ($quota eq '') {
  264:                 $quota = 500;
  265:             }
  266:             my $current_disk_usage = 0;
  267:             if (grep(/^\Q$chome\E$/,@ids)) {
  268:                 my $dir = &propath($dom,$cnum).'/userfiles/';
  269:                 foreach my $subdir ('docs','supplemental') {
  270:                     my $ududir = "$dir/$subdir";
  271:                     my $total_size=0;
  272:                     my $code=sub {
  273:                         if (-d $_) { return;}
  274:                         $total_size+=(stat($_))[7];
  275:                     };
  276:                     chdir($ududir);
  277:                     find($code,$ududir);
  278:                     $total_size=int($total_size/(1024*1024));
  279:                     $current_disk_usage += $total_size;
  280:                 }
  281:             } else {
  282:                 foreach my $subdir ('docs','supplemental') {
  283:                     $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
  284:                 }
  285:                 $current_disk_usage=int($current_disk_usage/1024);
  286:             }
  287:             my $percent;
  288:             if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
  289:                 $percent = 100.0;
  290:             } else {
  291:                 $percent = 100*($current_disk_usage/$quota);
  292:             }
  293:             $current_disk_usage = sprintf("%.0f",$current_disk_usage);
  294:             $quota = sprintf("%.0f",$quota);
  295:             $percent = sprintf("%.0f",$percent);
  296:             print(&Apache::loncommon::start_data_table_row().
  297:                   '<td>'.$quotatype.'</td>'.
  298:                   '<td>'.$cdesc.'</td>'.
  299:                   '<td>'.$instcode.'</td>'.
  300:                   '<td>'.$quota.'</td>'.
  301:                   '<td>'.$current_disk_usage.'</td>'.
  302:                   '<td>'.$percent.'</td>'.
  303:                    &Apache::loncommon::end_data_table_row()
  304:                   );
  305:         }
  306:         print(&Apache::loncommon::end_data_table().'<br /><br />');
  307:     } else {
  308:         print(&Apache::lonlocal::mt('No courses match search criteria.'));
  309:     }
  310:     return;
  311: }
  312: 
  313: sub get_filters {
  314:     my ($dom,$params) = @_;
  315:     my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
  316:                       'ownerdomfilter','coursefilter','sincefilter');
  317:     # created filter
  318:     my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
  319:     if ($loncaparev ne 'unknown_cmd') {
  320:         push(@filterlist,'createdfilter');
  321:     }
  322:     my %filter;
  323:     foreach my $item (@filterlist) {
  324:         $filter{$item} = '';
  325:     }
  326:     if (ref($params) eq 'HASH') {
  327:         foreach my $item (@filterlist) {
  328:             $filter{$item} = $params->{$item};
  329:         }
  330:     }
  331:     return (\@filterlist,\%filter);
  332: }
  333: