Return to quotacheck.pl CVS log

Up to [LON-CAPA] / loncom / cgi

Columns are sortable in the course quota list as well as well as the resource list in authoring space.  An up or down arrow is displayed next to the sorted column header indicating whether it is in ascending or descending order.

This resolves Bug #6704

    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.6 2014/08/05 19:32:19 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:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
   97:         my $q = CGI->new;
   98:         %params = $q->Vars;
   99:         $crstype = 'Course';
  100:         if ($params{'type'} eq 'Community') {
  101:             $crstype = $params{'type'};
  102:         }
  103:         if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
  104:         unless ($params{'sortby'}) { $params{'sortby'} = 'cdesc'; }
  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=>$script."?domain=$reqdom",
  125:        text=>"Content disk usage"});
  126:     if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
  127:         &Apache::lonhtmlcommon::add_breadcrumb
  128:             ({href=>$script."?domain=$reqdom",
  129:               text=>"Result"});
  130:     }
  131:     my $domdesc = &Apache::lonnet::domain($reqdom,'description');
  132:     my $starthash = {
  133:         add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
  134:     };
  135:     print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
  136:           &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
  137:           '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
  138:           '<h3>'.$domdesc.'</h3>');
  139:     my $changejs = <<"ENDSCRIPT";
  140: <script>
  141: function changeSort(sortby) {
  142:     document.filterpicker.sortby.value = sortby;
  143:     if (('$params{'sortby'}' == sortby) && ('$params{'sortorder'}' != 'rev')) { 
  144:         document.filterpicker.sortorder.value = 'rev'; 
  145:     }
  146:     document.filterpicker.submit();
  147: }
  148: </script>
  149: ENDSCRIPT
  150: 
  151:     print($changejs);
  152: 
  153: #
  154: #  If this is for an authenticated user (i.e., not IP-based access)
  155: #  create display to choose filters to restrict courses/communities displayed
  156: #  (e.g., recent activity, recently created, institutional code, course owner etc.)
  157: #
  158: 
  159:     if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
  160:         my ($numtitles,@codetitles);
  161:         print(&Apache::loncommon::js_changer());
  162:         my ($filterlist,$filter) = &get_filters($reqdom,\%params);
  163:         $Apache::lonnet::env{'form.official'} = $params{'official'};
  164:         if ($params{'official'}) {
  165:             my @standardnames = &Apache::loncommon::get_standard_codeitems();
  166:             pop(@standardnames);
  167:             foreach my $item (@standardnames) {
  168:                 if ($params{'official'} eq 'on') {
  169:                     $Apache::lonnet::env{'form.'.$item} = $params{$item};
  170:                 } else {
  171:                     $Apache::lonnet::env{'form.'.$item} = 0;
  172:                 }
  173:             }
  174:             $Apache::lonnet::env{'form.state'} = $params{'state'};
  175:         }
  176:         print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
  177:                                                 $script,\$numtitles,
  178:                                                 'quotacheck',undef,undef,undef,
  179:                                                 \@codetitles,$reqdom,'quotacheck',$reqdom));
  180:         if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
  181:             if ($params{'official'} eq 'on') {
  182:                 $Apache::lonnet::env{'form.state'} = $params{'state'};
  183:             }
  184:             # Sort by course title (cdesc) as default, not reversed
  185:             my $sortby = $params{'sortby'};
  186:             unless  ($sortby =~ m{^(quota|current_disk_usage|percent|quotatype|instcode)$}) {
  187:                 $sortby = 'cdesc';
  188:             }
  189:             my $sortorder;
  190:             if ($params{'sortorder'} eq 'rev') { $sortorder = 'rev'; }
  191: 
  192:             my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
  193:                                                              undef,undef,undef,\@codetitles);
  194:             my @showcourses = keys(%courses);
  195:             &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder);
  196:         }
  197: 
  198:         print(&Apache::loncommon::end_page());
  199:         return;
  200:     }
  201:     &print_usage($lonhost,$reqdom);
  202:     print(&Apache::loncommon::end_page());
  203:     return;
  204: }
  205: 
  206: sub print_usage {
  207:     my ($lonhost,$dom,$courses,$sortby,$sortorder) = @_;
  208:     my @domains = &Apache::lonnet::current_machine_domains();
  209:     my @ids=&Apache::lonnet::current_machine_ids();
  210:     my $domain = &Apache::lonnet::host_domain($lonhost);
  211: 
  212: #
  213: # If user's current role is domain coordinator, domain of courses/communities
  214: # to be shown needs to be domain being coordinated. 
  215: #
  216:     if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
  217:         $domain = $Apache::lonnet::env{'request.role.domain'};
  218:         unless ($dom eq $domain) {
  219:             my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
  220:             print('<p class="LC_error">'.
  221:                   &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
  222:                   '</p>'."\n".
  223:                   '<p class="LC_info">'.
  224:                   &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
  225:                                         '<a href="'.$script.'?domain='.$domain.'">'.
  226:                                         $otherdomdesc.'</a>').
  227:                   '</p>');
  228:             return;
  229:         }
  230:     } else {
  231:         unless (grep(/^\Q$dom\E/,@domains)) {
  232:             print('<p class="LC_error">'.
  233:                   &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
  234:                   '</p>');
  235:             return;
  236:         }
  237:     }
  238:     my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
  239:     my @showcourses;
  240:     if (ref($courses) eq 'ARRAY') {
  241:         @showcourses = @{$courses};
  242:     } else {
  243:         my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
  244:         if (keys(%courseshash)) {
  245:             @showcourses = keys(%courseshash);
  246:         }
  247:     }
  248: 
  249:     if (@showcourses) {
  250:         # Order in which columns are displayed from left to right
  251:         my @order = ('quotatype','cdesc','instcode','quota',
  252:                         'current_disk_usage','percent');
  253: 
  254:         # Up and down arrows to indicate sort order
  255:         my @arrows = ('&nbsp;&#9650;','&nbsp;&#9660;','');
  256: 
  257:         # Default sort order and column title
  258:         my %columns = (
  259:             quotatype => {
  260:                         order => 'ascending',
  261:                         text  => &Apache::lonlocal::mt('Course Type'),
  262:                          },
  263:             cdesc => {
  264:                         order => 'ascending',
  265:                         text  => &Apache::lonlocal::mt('Course Title'),
  266:                      },
  267:             instcode => {
  268:                         order => 'ascending',
  269:                         text  => &Apache::lonlocal::mt('Institutional Code'),
  270:                         },
  271:             quota => {
  272:                         order => 'descending',
  273:                         text  => &Apache::lonlocal::mt('Quota (MB)'),
  274:                      },
  275:             current_disk_usage => {
  276:                         order => 'descending',
  277:                         text  => &Apache::lonlocal::mt('Usage (MB)'),
  278:                                   },
  279:             percent => {
  280:                         order => 'descending',
  281:                         text  => &Apache::lonlocal::mt('Percent usage'),
  282:                        },
  283:         ); 
  284:         
  285:         # Print column headers
  286:         my $output = '';
  287:         foreach my $key (@order) {
  288:             my $idx;
  289:             # Append an up or down arrow to sorted column
  290:             if ($sortby eq $key) {
  291:                 $idx = ($columns{$key}{order} eq 'ascending') ? 0:1;
  292:                 if ($sortorder eq 'rev') { $idx ++; }
  293:                 $idx = $idx%2;
  294:             } else { $idx = 2; } # No arrow if column not sorted
  295:             $output .= '<th><a href="javascript:changeSort('
  296:                         ."'$key'".');">'.$columns{$key}{text}
  297:                         .$arrows[$idx].'</a></th>';
  298:         }
  299:         print(&Apache::loncommon::start_data_table()
  300:             .&Apache::loncommon::start_data_table_header_row().$output
  301:             .&Apache::loncommon::end_data_table_header_row());
  302:              
  303:         my $usagehash = {};  # Sortable hash of courses
  304:         foreach my $cid (@showcourses) {
  305:             my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
  306:             my $cdesc = $courseinfo{'description'};
  307:             my $cnum = $courseinfo{'num'};
  308:             my $chome = $courseinfo{'home'};
  309:             my $crstype = $courseinfo{'type'};
  310:             if ($crstype eq '') {
  311:                 if ($cnum =~ /^$LONCAPA::match_community$/) {
  312:                     $crstype = 'Community';
  313:                 } else {
  314:                     $crstype = 'Course';
  315:                 }
  316:             }
  317:             my $instcode = $courseinfo{'internal.coursecode'};
  318:             my $quota = $courseinfo{'internal.uploadquota'};
  319:             $quota =~ s/[^\d\.]+//g;
  320:             my $quotatype = 'unofficial';
  321:             if ($crstype eq 'Community') {
  322:                 $quotatype = 'community';
  323:             } elsif ($courseinfo{'internal.coursecode'}) {
  324:                 $quotatype = 'official';
  325:             } elsif ($courseinfo{'internal.textbook'}) {
  326:                 $quotatype = 'textbook';
  327:             }
  328:             if ($quota eq '') {
  329:                 $quota = $domdefs{$crstype.'quota'};
  330:             }
  331:             $quota =~ s/[^\d\.]+//g;
  332:             if ($quota eq '') {
  333:                 $quota = 500;
  334:             }
  335:             my $current_disk_usage = 0;
  336:             if (grep(/^\Q$chome\E$/,@ids)) {
  337:                 my $dir = &propath($dom,$cnum).'/userfiles/';
  338:                 foreach my $subdir ('docs','supplemental') {
  339:                     my $ududir = "$dir/$subdir";
  340:                     my $total_size=0;
  341:                     my $code=sub {
  342:                         if (-d $_) { return;}
  343:                         $total_size+=(stat($_))[7];
  344:                     };
  345:                     chdir($ududir);
  346:                     find($code,$ududir);
  347:                     $total_size=int($total_size/(1024*1024));
  348:                     $current_disk_usage += $total_size;
  349:                 }
  350:             } else {
  351:                 foreach my $subdir ('docs','supplemental') {
  352:                     $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
  353:                 }
  354:             }
  355:             my $percent;
  356:             if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
  357:                 $percent = 100.0;
  358:             } else {
  359:                 $percent = 100*($current_disk_usage/$quota);
  360:             }
  361:             $current_disk_usage = sprintf("%.0f",$current_disk_usage);
  362:             $quota = sprintf("%.0f",$quota);
  363:             $percent = sprintf("%.0f",$percent);
  364: 
  365:             # Enter sortable data into hash
  366:             $usagehash->{ $cid } = {
  367:                 "quotatype"             => $quotatype,
  368:                 "cdesc"                 => $cdesc,
  369:                 "instcode"              => $instcode,
  370:                 "quota"                 => $quota,
  371:                 "current_disk_usage"    => $current_disk_usage,
  372:                 "percent"               => $percent,
  373:             };
  374:         }
  375: 
  376:         # Sort courses by $sortby.  "cdesc" is the default.
  377:         my @sorted_courses;
  378:         if ($sortby =~ m{^(quota|current_disk_usage|percent)$}) {
  379:             # Numerical fields
  380:             if ($sortorder eq "rev") {
  381:                 @sorted_courses = sort {
  382:                     $usagehash->{$a}->{$sortby} <=> $usagehash->{$b}->{$sortby}
  383:                         or
  384:                     uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
  385:                 } (keys(%{$usagehash}));
  386:             } else {
  387:                 @sorted_courses = sort {
  388:                     $usagehash->{$b}->{$sortby} <=> $usagehash->{$a}->{$sortby}
  389:                         or
  390:                     uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
  391:                 } (keys(%{$usagehash}));
  392:             }
  393:         } elsif ($sortby =~ m{^(cdesc|quotatype|instcode)$}) {
  394:             # String fields
  395:             if ($sortorder eq "rev") {
  396:                 @sorted_courses = sort {
  397:                     uc($usagehash->{$b}->{$sortby}) cmp uc($usagehash->{$a}->{$sortby})
  398:                         or
  399:                     uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
  400:                 } (keys(%{$usagehash}));
  401:             } else {
  402:                 @sorted_courses = sort {
  403:                     uc($usagehash->{$a}->{$sortby}) cmp uc($usagehash->{$b}->{$sortby})
  404:                         or
  405:                     uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
  406:                 } (keys(%{$usagehash}));
  407:             }
  408:         }
  409: 
  410:         # Print data for each course.
  411:         foreach my $course (@sorted_courses) {
  412:             print(&Apache::loncommon::start_data_table_row().
  413:                   '<td>'.$usagehash->{$course}->{"quotatype"}.'</td>'.
  414:                   '<td>'.$usagehash->{$course}->{"cdesc"}.'</td>'.
  415:                   '<td>'.$usagehash->{$course}->{"instcode"}.'</td>'.
  416:                   '<td>'.$usagehash->{$course}->{"quota"}.'</td>'.
  417:                   '<td>'.$usagehash->{$course}->{"current_disk_usage"}.'</td>'.
  418:                   '<td>'.$usagehash->{$course}->{"percent"}.'</td>'.
  419:                    &Apache::loncommon::end_data_table_row()
  420:                   );
  421:         }
  422:         print(&Apache::loncommon::end_data_table().'<br /><br />');
  423:     } else {
  424:         print(&Apache::lonlocal::mt('No courses match search criteria.'));
  425:     }
  426:     return;
  427: }
  428: 
  429: sub get_filters {
  430:     my ($dom,$params) = @_;
  431:     my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
  432:                       'ownerdomfilter','coursefilter','sincefilter');
  433:     # created filter
  434:     my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
  435:     if ($loncaparev ne 'unknown_cmd') {
  436:         push(@filterlist,'createdfilter');
  437:     }
  438:     my %filter;
  439:     foreach my $item (@filterlist) {
  440:         $filter{$item} = '';
  441:     }
  442:     if (ref($params) eq 'HASH') {
  443:         foreach my $item (@filterlist) {
  444:             $filter{$item} = $params->{$item};
  445:         }
  446:     }
  447:     return (\@filterlist,\%filter);
  448: }
  449: