File:
[LON-CAPA] /
loncom /
cgi /
quotacheck.pl
Revision
1.8:
download - view:
text,
annotated -
select for diffs
Mon May 4 15:13:57 2015 UTC (9 years, 3 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
HEAD
- Don't display unfiltered search results on initial load.
- Eliminate javascript error on load when selected course type is Community.
- Support sortby, sortorder, and type (official, unofficial, or Community)
in query string when IP-based access in use.
- Omit instcode column unless displaying quotas for any course type,
or for official courses only.
#!/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.8 2015/05/04 15:13:57 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 = (' ▲',' ▼','');
# 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);
}
}
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);
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>