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

#!/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.6 2014/08/05 19:32:19 musolffc 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::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 (%gets,%posted,$reqdom,$crstype,%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'};
        }
        if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
        unless ($params{'sortby'}) { $params{'sortby'} = 'cdesc'; }
    }
    if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
        &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 ($reqdom eq '') {
        $reqdom = &Apache::lonnet::default_login_domain();
    }

    &Apache::lonlocal::get_language_handle();
    &Apache::lonhtmlcommon::add_breadcrumb
    ({href=>$script."?domain=$reqdom",
       text=>"Content disk usage"});
    if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>$script."?domain=$reqdom",
              text=>"Result"});
    }
    my $domdesc = &Apache::lonnet::domain($reqdom,'description');
    my $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>');
    my $changejs = <<"ENDSCRIPT";
<script>
function changeSort(sortby) {
    document.filterpicker.sortby.value = sortby;
    if (('$params{'sortby'}' == sortby) && ('$params{'sortorder'}' != 'rev')) { 
        document.filterpicker.sortorder.value = 'rev'; 
    }
    document.filterpicker.submit();
}
</script>
ENDSCRIPT

    print($changejs);

#
#  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 (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
        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};
                } else {
                    $Apache::lonnet::env{'form.'.$item} = 0;
                }
            }
            $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'};
            }
            # 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'; }

            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);
        }

        print(&Apache::loncommon::end_page());
        return;
    }
    &print_usage($lonhost,$reqdom);
    print(&Apache::loncommon::end_page());
    return;
}

sub print_usage {
    my ($lonhost,$dom,$courses,$sortby,$sortorder) = @_;
    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) {
            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
            $output .= '<th><a href="javascript:changeSort('
                        ."'$key'".');">'.$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{$crstype.'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);
                }
            }
            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>'.
                  '<td>'.$usagehash->{$course}->{"instcode"}.'</td>'.
                  '<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);
}