Return to quotacheck.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- When quotacheck is run on an access node totals from lonnet::diskusage()
  need to be converted from KB to MB.

#!/usr/bin/perl
$|=1;
# Display quotas for uploaded course content, current disk usage and
# percent usage for courses and communities for requested domain.
# Requester should either be an active domain coordinator in 
# requested domain, or current server should belong to requested
# domain.
#
# $Id: quotacheck.pl,v 1.9 2021/09/03 21:37:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

use strict;

use lib '/home/httpd/lib/perl/';
use Apache::lonnet();
use Apache::loncommon();
use Apache::courseclassifier();
use Apache::lonlocal();
use LONCAPA::Configuration();
use LONCAPA::loncgi();
use LONCAPA::lonauthcgi();
use File::Find;
use CGI qw(:standard);
use LONCAPA;

my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
my $lonhost;
if (ref($perlvar) eq 'HASH') {
    $lonhost = $perlvar->{'lonHostID'};
}
undef($perlvar);

my $script = "/cgi-bin/quotacheck.pl";

print &LONCAPA::loncgi::cgi_header('text/html',1);
&main($lonhost);

sub main {
    my ($lonhost) = @_;
    if ($lonhost eq '') {
        &Apache::lonlocal::get_language_handle();
        &Apache::lonhtmlcommon::add_breadcrumb
        ({href=>$script,
          text=>"Content disk usage"});
        print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
              &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
              '<p class="LC_error">'.
              &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
              '</p>'
              &Apache::loncommon::end_page());
        return;
    }
    if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
        &LONCAPA::loncgi::check_cookie_and_load_env();
    } else {
        if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
            &Apache::lonlocal::get_language_handle();
            print(&LONCAPA::loncgi::missing_cookie_msg());
            return;
        }
        if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
            &Apache::lonlocal::get_language_handle();
            print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
            return;
        }
    }
    my ($reqdom,$crstype,$type,%params);

#
#  Get domain -- if this is for an authenticated user (i.e., not IP-based access)
#  Set domain in the order (a) value of fixeddom form element, if submitted
#                          (b) value of domain item in query string
#                          (c) default login domain for current server   
#
    if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
        my $q = CGI->new;
        %params = $q->Vars;
        $crstype = 'Course';
        if ($params{'type'} eq 'Community') {
            $crstype = $params{'type'};
            $type = $crstype;
        }
        if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
    }
    if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
        my %gets;    
        &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
        if (ref($gets{'domain'}) eq 'ARRAY') {
            $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
            if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
                my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
                unless ($domdesc eq '') {
                    $reqdom = $gets{'domain'}->[0];
                }
            }
        }
        if (($crstype eq '') && (ref($gets{'type'}) eq 'ARRAY')) {
            $gets{'type'}->[0] =~ s/^\s+|\s+$//g;
            if (lc($gets{'type'}->[0]) eq 'community') {
                $crstype = 'Community';
            } elsif ($gets{'type'}->[0] =~ /^(un|)official$/) {
                $crstype = $gets{'type'}->[0];
            }
        }
        if (($params{'sortby'} eq '') && (ref($gets{'sortby'}) eq 'ARRAY')){
            $gets{'sortby'}->[0] =~ s/^\s+|\s+$//g;
            if ($gets{'sortby'}->[0] =~ /^(quota|current_disk_usage|percent|quotatype|instcode)$/) {
                $params{'sortby'} = $1;
            }
        }
        if (($params{'sortorder'} eq '') && (ref($gets{'sortorder'}) eq 'ARRAY')){
            $gets{'sortorder'}->[0] =~ s/^\s+|\s+$//g;
            if ($gets{'sortorder'}->[0] eq 'rev') {
                $params{'sortorder'} = $gets{'sortorder'}->[0];
            }
        }
    }
    if ($reqdom eq '') {
        $reqdom = &Apache::lonnet::default_login_domain();
    }
    my $knownuser;
    if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
        $knownuser = 1;
    }
    &Apache::lonlocal::get_language_handle();
    &Apache::lonhtmlcommon::add_breadcrumb
    ({href=>$script."?domain=$reqdom",
       text=>"Content disk usage"});
    if ((($params{'gosearch'}) || ($params{'sortby'})) && ($knownuser)) {
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>$script."?domain=$reqdom",
              text=>"Result"});
    }
    my $domdesc = &Apache::lonnet::domain($reqdom,'description');
    my $starthash;
    unless ($crstype eq 'Community') {
        $starthash = {
            add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
        };
    }
    print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
          &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
          '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
          '<h3>'.$domdesc.'</h3>');

# Sort by course title (cdesc) as default, not reversed
    my $sortby = $params{'sortby'};
    unless  ($sortby =~ m{^(quota|current_disk_usage|percent|quotatype|instcode)$}) {
        $sortby = 'cdesc';
    }
    my $sortorder;
    if ($params{'sortorder'} eq 'rev') { $sortorder = 'rev'; }

#
#  If this is for an authenticated user (i.e., not IP-based access)
#  create display to choose filters to restrict courses/communities displayed
#  (e.g., recent activity, recently created, institutional code, course owner etc.)
#

    if ($knownuser) {
        print <<"ENDSCRIPT";
<script>
function changeSort(sortby) {
    document.filterpicker.sortby.value = sortby;
    if (('$sortby' == sortby) && ('$params{'sortorder'}' != 'rev')) {
        document.filterpicker.sortorder.value = 'rev';
    }
    document.filterpicker.submit();
}
</script>
ENDSCRIPT
        my ($numtitles,@codetitles);
        print(&Apache::loncommon::js_changer());
        my ($filterlist,$filter) = &get_filters($reqdom,\%params);
        $Apache::lonnet::env{'form.official'} = $params{'official'};
        if ($params{'official'}) {
            my @standardnames = &Apache::loncommon::get_standard_codeitems();
            pop(@standardnames);
            foreach my $item (@standardnames) {
                if ($params{'official'} eq 'on') {
                    $Apache::lonnet::env{'form.'.$item} = $params{$item};
                    $type = 'official';
                } else {
                    $Apache::lonnet::env{'form.'.$item} = 0;
                    $type = 'unofficial';
                }
            }
            $Apache::lonnet::env{'form.state'} = $params{'state'};
        }
        print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
                                                $script,\$numtitles,
                                                'quotacheck',undef,undef,undef,
                                                \@codetitles,$reqdom,'quotacheck',$reqdom));
        if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
            if ($params{'official'} eq 'on') {
                $Apache::lonnet::env{'form.state'} = $params{'state'};
            }
            my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
                                                             undef,undef,undef,\@codetitles);
            my @showcourses = keys(%courses);
            &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder,$type,
                         $knownuser,$script);
        }
    } else {
        my ($instcodefilter,$regexpok,@showcourses);
        $instcodefilter = '.';
        if ($crstype eq '') {
            $crstype = '.';
        } elsif ($crstype =~ /^(un|)official$/) {
            $type = $crstype;
            my ($numtitles,@codetitles,%cat_items,%cat_titles,%cat_order);
            (undef,undef,$numtitles) =
                &Apache::courseclassifier::instcode_selectors_data($reqdom,'filterpicker',
                                                                   \%cat_items,\@codetitles,
                                                                   \%cat_titles,\%cat_order);
            foreach my $item (@codetitles) {
                $Apache::lonnet::env{'form.'.$item} = 0;
            }
            $instcodefilter =
                &Apache::courseclassifier::instcode_search_str($reqdom,$numtitles,\@codetitles);
            if ($crstype eq 'official') {
                $regexpok = 1;
            } elsif ($crstype eq 'unofficial') {
                unless ($instcodefilter eq '') {
                    $regexpok = -1;
                }
            }
            $crstype = 'Course';
        }
        my %courseshash = &Apache::lonnet::courseiddump($reqdom,'.',1,$instcodefilter,'.','.',
                                                        undef,undef,$crstype,$regexpok);
        if (keys(%courseshash)) {
            @showcourses = keys(%courseshash);
        }
        &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder,$type,$knownuser,
                     $script);
    }
    print(&Apache::loncommon::end_page());
    return;
}

sub print_usage {
    my ($lonhost,$dom,$courses,$sortby,$sortorder,$type,$knownuser,$script) = @_;
    my @domains = &Apache::lonnet::current_machine_domains();
    my @ids=&Apache::lonnet::current_machine_ids();
    my $domain = &Apache::lonnet::host_domain($lonhost);

#
# If user's current role is domain coordinator, domain of courses/communities
# to be shown needs to be domain being coordinated. 
#
    if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
        $domain = $Apache::lonnet::env{'request.role.domain'};
        unless ($dom eq $domain) {
            my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
            print('<p class="LC_error">'.
                  &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
                  '</p>'."\n".
                  '<p class="LC_info">'.
                  &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
                                        '<a href="'.$script.'?domain='.$domain.'">'.
                                        $otherdomdesc.'</a>').
                  '</p>');
            return;
        }
    } else {
        unless (grep(/^\Q$dom\E/,@domains)) {
            print('<p class="LC_error">'.
                  &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
                  '</p>');
            return;
        }
    }
    my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
    my @showcourses;
    if (ref($courses) eq 'ARRAY') {
        @showcourses = @{$courses};
    } else {
        my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
        if (keys(%courseshash)) {
            @showcourses = keys(%courseshash);
        }
    }

    if (@showcourses) {
        # Order in which columns are displayed from left to right
        my @order = ('quotatype','cdesc','instcode','quota',
                        'current_disk_usage','percent');

        # Up and down arrows to indicate sort order
        my @arrows = ('&nbsp;&#9650;','&nbsp;&#9660;','');

        # Default sort order and column title
        my %columns = (
            quotatype => {
                        order => 'ascending',
                        text  => &Apache::lonlocal::mt('Course Type'),
                         },
            cdesc => {
                        order => 'ascending',
                        text  => &Apache::lonlocal::mt('Course Title'),
                     },
            instcode => {
                        order => 'ascending',
                        text  => &Apache::lonlocal::mt('Institutional Code'),
                        },
            quota => {
                        order => 'descending',
                        text  => &Apache::lonlocal::mt('Quota (MB)'),
                     },
            current_disk_usage => {
                        order => 'descending',
                        text  => &Apache::lonlocal::mt('Usage (MB)'),
                                  },
            percent => {
                        order => 'descending',
                        text  => &Apache::lonlocal::mt('Percent usage'),
                       },
        ); 
        
        # Print column headers
        my $output = '';
        foreach my $key (@order) {
            next if (($key eq 'instcode') && ($type ne 'official') && ($type ne ''));
            my $idx;
            # Append an up or down arrow to sorted column
            if ($sortby eq $key) {
                $idx = ($columns{$key}{order} eq 'ascending') ? 0:1;
                if ($sortorder eq 'rev') { $idx ++; }
                $idx = $idx%2;
            } else { $idx = 2; } # No arrow if column not sorted
            my $link =  'javascript:changeSort('."'$key'".');';
            if (!$knownuser) {
                $link = $script.'?domain='.$dom.'&sortby='.$key;
                if ($type =~ /^((un|)official)|(C|c)ommunity/) {
                    $link .='&type='.$type;
                }
                if ($sortby eq $key) {
                    unless ($sortorder) {
                        $link .= '&sortorder=rev';
                    }
                }
            }
            $output .= '<th><a href="'.$link.'"">'.$columns{$key}{text}
                      .$arrows[$idx].'</a></th>';
        }
        print(&Apache::loncommon::start_data_table()
            .&Apache::loncommon::start_data_table_header_row().$output
            .&Apache::loncommon::end_data_table_header_row());
             
        my $usagehash = {};  # Sortable hash of courses
        foreach my $cid (@showcourses) {
            my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
            my $cdesc = $courseinfo{'description'};
            my $cnum = $courseinfo{'num'};
            my $chome = $courseinfo{'home'};
            my $crstype = $courseinfo{'type'};
            if ($crstype eq '') {
                if ($cnum =~ /^$LONCAPA::match_community$/) {
                    $crstype = 'Community';
                } else {
                    $crstype = 'Course';
                }
            }
            my $instcode = $courseinfo{'internal.coursecode'};
            my $quota = $courseinfo{'internal.uploadquota'};
            $quota =~ s/[^\d\.]+//g;
            my $quotatype = 'unofficial';
            if ($crstype eq 'Community') {
                $quotatype = 'community';
            } elsif ($courseinfo{'internal.coursecode'}) {
                $quotatype = 'official';
            } elsif ($courseinfo{'internal.textbook'}) {
                $quotatype = 'textbook';
            }
            if ($quota eq '') {
                $quota = $domdefs{$quotatype.'quota'};
            }
            $quota =~ s/[^\d\.]+//g;
            if ($quota eq '') {
                $quota = 500;
            }
            my $current_disk_usage = 0;
            if (grep(/^\Q$chome\E$/,@ids)) {
                my $dir = &propath($dom,$cnum).'/userfiles/';
                foreach my $subdir ('docs','supplemental') {
                    my $ududir = "$dir/$subdir";
                    my $total_size=0;
                    my $code=sub {
                        if (-d $_) { return;}
                        $total_size+=(stat($_))[7];
                    };
                    chdir($ududir);
                    find($code,$ududir);
                    $total_size=int($total_size/(1024*1024));
                    $current_disk_usage += $total_size;
                }
            } else {
                foreach my $subdir ('docs','supplemental') {
                    $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
                }
                $current_disk_usage = $current_disk_usage/1024;
            }
            my $percent;
            if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
                $percent = 100.0;
            } else {
                $percent = 100*($current_disk_usage/$quota);
            }
            $current_disk_usage = sprintf("%.0f",$current_disk_usage);
            $quota = sprintf("%.0f",$quota);
            $percent = sprintf("%.0f",$percent);

            # Enter sortable data into hash
            $usagehash->{ $cid } = {
                "quotatype"             => $quotatype,
                "cdesc"                 => $cdesc,
                "instcode"              => $instcode,
                "quota"                 => $quota,
                "current_disk_usage"    => $current_disk_usage,
                "percent"               => $percent,
            };
        }

        # Sort courses by $sortby.  "cdesc" is the default.
        my @sorted_courses;
        if ($sortby =~ m{^(quota|current_disk_usage|percent)$}) {
            # Numerical fields
            if ($sortorder eq "rev") {
                @sorted_courses = sort {
                    $usagehash->{$a}->{$sortby} <=> $usagehash->{$b}->{$sortby}
                        or
                    uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
                } (keys(%{$usagehash}));
            } else {
                @sorted_courses = sort {
                    $usagehash->{$b}->{$sortby} <=> $usagehash->{$a}->{$sortby}
                        or
                    uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
                } (keys(%{$usagehash}));
            }
        } elsif ($sortby =~ m{^(cdesc|quotatype|instcode)$}) {
            # String fields
            if ($sortorder eq "rev") {
                @sorted_courses = sort {
                    uc($usagehash->{$b}->{$sortby}) cmp uc($usagehash->{$a}->{$sortby})
                        or
                    uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
                } (keys(%{$usagehash}));
            } else {
                @sorted_courses = sort {
                    uc($usagehash->{$a}->{$sortby}) cmp uc($usagehash->{$b}->{$sortby})
                        or
                    uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
                } (keys(%{$usagehash}));
            }
        }

        # Print data for each course.
        foreach my $course (@sorted_courses) {
            print(&Apache::loncommon::start_data_table_row().
                  '<td>'.$usagehash->{$course}->{"quotatype"}.'</td>'.
                  '<td>'.$usagehash->{$course}->{"cdesc"}.'</td>');
            if (($type eq 'official') || (!$type)) {
                print('<td>'.$usagehash->{$course}->{"instcode"}.'</td>');
            }
            print('<td>'.$usagehash->{$course}->{"quota"}.'</td>'.
                  '<td>'.$usagehash->{$course}->{"current_disk_usage"}.'</td>'.
                  '<td>'.$usagehash->{$course}->{"percent"}.'</td>'.
                   &Apache::loncommon::end_data_table_row()
                  );
        }
        print(&Apache::loncommon::end_data_table().'<br /><br />');
    } else {
        print(&Apache::lonlocal::mt('No courses match search criteria.'));
    }
    return;
}

sub get_filters {
    my ($dom,$params) = @_;
    my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
                      'ownerdomfilter','coursefilter','sincefilter');
    # created filter
    my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
    if ($loncaparev ne 'unknown_cmd') {
        push(@filterlist,'createdfilter');
    }
    my %filter;
    foreach my $item (@filterlist) {
        $filter{$item} = '';
    }
    if (ref($params) eq 'HASH') {
        foreach my $item (@filterlist) {
            $filter{$item} = $params->{$item};
        }
    }
    return (\@filterlist,\%filter);
}