Annotation of loncom/cgi/quotacheck.pl, revision 1.6

1.1       raeburn     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: #
1.6     ! musolffc    9: # $Id: quotacheck.pl,v 1.5 2014/07/31 15:57:24 musolffc Exp $
1.1       raeburn    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: 
1.3       musolffc   54: my $script = "/cgi-bin/quotacheck.pl";
                     55: 
1.1       raeburn    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
1.3       musolffc   64:         ({href=>$script,
1.1       raeburn    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:         }
1.5       musolffc  103:         if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
1.6     ! musolffc  104:         unless ($params{'sortby'}) { $params{'sortby'} = 'cdesc'; }
1.1       raeburn   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
1.3       musolffc  124:     ({href=>$script."?domain=$reqdom",
1.1       raeburn   125:        text=>"Content disk usage"});
1.5       musolffc  126:     if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
1.1       raeburn   127:         &Apache::lonhtmlcommon::add_breadcrumb
1.3       musolffc  128:             ({href=>$script."?domain=$reqdom",
1.1       raeburn   129:               text=>"Result"});
                    130:     }
                    131:     my $domdesc = &Apache::lonnet::domain($reqdom,'description');
1.4       musolffc  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).
1.1       raeburn   136:           &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
                    137:           '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
                    138:           '<h3>'.$domdesc.'</h3>');
1.5       musolffc  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);
1.1       raeburn   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,
1.3       musolffc  177:                                                 $script,\$numtitles,
1.1       raeburn   178:                                                 'quotacheck',undef,undef,undef,
                    179:                                                 \@codetitles,$reqdom,'quotacheck',$reqdom));
1.5       musolffc  180:         if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
1.1       raeburn   181:             if ($params{'official'} eq 'on') {
                    182:                 $Apache::lonnet::env{'form.state'} = $params{'state'};
                    183:             }
1.5       musolffc  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: 
1.1       raeburn   192:             my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
                    193:                                                              undef,undef,undef,\@codetitles);
                    194:             my @showcourses = keys(%courses);
1.5       musolffc  195:             &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder);
1.1       raeburn   196:         }
1.5       musolffc  197: 
1.1       raeburn   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 {
1.5       musolffc  207:     my ($lonhost,$dom,$courses,$sortby,$sortorder) = @_;
1.1       raeburn   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]',
1.3       musolffc  225:                                         '<a href="'.$script.'?domain='.$domain.'">'.
1.1       raeburn   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:     }
1.5       musolffc  248: 
1.1       raeburn   249:     if (@showcourses) {
1.6     ! musolffc  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
1.5       musolffc  301:             .&Apache::loncommon::end_data_table_header_row());
                    302:              
                    303:         my $usagehash = {};  # Sortable hash of courses
1.1       raeburn   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);
1.5       musolffc  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) {
1.1       raeburn   412:             print(&Apache::loncommon::start_data_table_row().
1.5       musolffc  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>'.
1.1       raeburn   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: 

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