Return to quotacheck.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Disk usage displayed in 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.2 2014/06/13 18:50:07 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::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);

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=>"/cgi-bin/quotacheck.pl",
          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'};
        }
    }
    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=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
       text=>"Content disk usage"});
    if ($params{'gosearch'}) {
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
              text=>"Result"});
    }
    my $domdesc = &Apache::lonnet::domain($reqdom,'description');
    print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
          &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
          '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
          '<h3>'.$domdesc.'</h3>');

#
#  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,
                                                '/cgi-bin/quotacheck.pl',\$numtitles,
                                                'quotacheck',undef,undef,undef,
                                                \@codetitles,$reqdom,'quotacheck',$reqdom));
        if ($params{'gosearch'}) {
            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);
        }
        print(&Apache::loncommon::end_page());
        return;
    }
    &print_usage($lonhost,$reqdom);
    print(&Apache::loncommon::end_page());
    return;
}

sub print_usage {
    my ($lonhost,$dom,$courses) = @_;
    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="/cgi-bin/quotacheck.pl?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) {
        print(&Apache::loncommon::start_data_table().
              &Apache::loncommon::start_data_table_header_row().
              '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
              '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
              '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
              '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
              '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
              '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
              &Apache::loncommon::end_data_table_header_row());
        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);
                }
                $current_disk_usage=int($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);
            print(&Apache::loncommon::start_data_table_row().
                  '<td>'.$quotatype.'</td>'.
                  '<td>'.$cdesc.'</td>'.
                  '<td>'.$instcode.'</td>'.
                  '<td>'.$quota.'</td>'.
                  '<td>'.$current_disk_usage.'</td>'.
                  '<td>'.$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);
}

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.