Annotation of loncom/cgi/quotacheck.pl, revision 1.1
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: #
! 9: # $Id: quotacheck.pl,v 1.1 2014/03/10 17:44:01 raeburn Exp $
! 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:
! 54: print &LONCAPA::loncgi::cgi_header('text/html',1);
! 55: &main($lonhost);
! 56:
! 57: sub main {
! 58: my ($lonhost) = @_;
! 59: if ($lonhost eq '') {
! 60: &Apache::lonlocal::get_language_handle();
! 61: &Apache::lonhtmlcommon::add_breadcrumb
! 62: ({href=>"/cgi-bin/quotacheck.pl",
! 63: text=>"Content disk usage"});
! 64: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
! 65: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
! 66: '<p class="LC_error">'.
! 67: &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
! 68: '</p>'
! 69: &Apache::loncommon::end_page());
! 70: return;
! 71: }
! 72: if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
! 73: &LONCAPA::loncgi::check_cookie_and_load_env();
! 74: } else {
! 75: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
! 76: &Apache::lonlocal::get_language_handle();
! 77: print(&LONCAPA::loncgi::missing_cookie_msg());
! 78: return;
! 79: }
! 80: if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
! 81: &Apache::lonlocal::get_language_handle();
! 82: print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
! 83: return;
! 84: }
! 85: }
! 86: my (%gets,%posted,$reqdom,$crstype,%params);
! 87:
! 88: #
! 89: # Get domain -- if this is for an authenticated user (i.e., not IP-based access)
! 90: # Set domain in the order (a) value of fixeddom form element, if submitted
! 91: # (b) value of domain item in query string
! 92: # (c) default login domain for current server
! 93: #
! 94:
! 95: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
! 96: my $q = CGI->new;
! 97: %params = $q->Vars;
! 98: $crstype = 'Course';
! 99: if ($params{'type'} eq 'Community') {
! 100: $crstype = $params{'type'};
! 101: }
! 102: if ($params{'fixeddom'}) {
! 103: $reqdom = $params{'fixeddom'};
! 104: }
! 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
! 124: ({href=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
! 125: text=>"Content disk usage"});
! 126: if ($params{'gosearch'}) {
! 127: &Apache::lonhtmlcommon::add_breadcrumb
! 128: ({href=>"/cgi-bin/quotacheck.pl?domain=$reqdom",
! 129: text=>"Result"});
! 130: }
! 131: my $domdesc = &Apache::lonnet::domain($reqdom,'description');
! 132: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
! 133: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
! 134: '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
! 135: '<h3>'.$domdesc.'</h3>');
! 136:
! 137: #
! 138: # If this is for an authenticated user (i.e., not IP-based access)
! 139: # create display to choose filters to restrict courses/communities displayed
! 140: # (e.g., recent activity, recently created, institutional code, course owner etc.)
! 141: #
! 142:
! 143: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
! 144: my ($numtitles,@codetitles);
! 145: print(&Apache::loncommon::js_changer());
! 146: my ($filterlist,$filter) = &get_filters($reqdom,\%params);
! 147: $Apache::lonnet::env{'form.official'} = $params{'official'};
! 148: if ($params{'official'}) {
! 149: my @standardnames = &Apache::loncommon::get_standard_codeitems();
! 150: pop(@standardnames);
! 151: foreach my $item (@standardnames) {
! 152: if ($params{'official'} eq 'on') {
! 153: $Apache::lonnet::env{'form.'.$item} = $params{$item};
! 154: } else {
! 155: $Apache::lonnet::env{'form.'.$item} = 0;
! 156: }
! 157: }
! 158: $Apache::lonnet::env{'form.state'} = $params{'state'};
! 159: }
! 160: print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
! 161: '/cgi-bin/quotacheck.pl',\$numtitles,
! 162: 'quotacheck',undef,undef,undef,
! 163: \@codetitles,$reqdom,'quotacheck',$reqdom));
! 164: if ($params{'gosearch'}) {
! 165: if ($params{'official'} eq 'on') {
! 166: $Apache::lonnet::env{'form.state'} = $params{'state'};
! 167: }
! 168: my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
! 169: undef,undef,undef,\@codetitles);
! 170: my @showcourses = keys(%courses);
! 171: &print_usage($lonhost,$reqdom,\@showcourses);
! 172: }
! 173: print(&Apache::loncommon::end_page());
! 174: return;
! 175: }
! 176: &print_usage($lonhost,$reqdom);
! 177: print(&Apache::loncommon::end_page());
! 178: return;
! 179: }
! 180:
! 181: sub print_usage {
! 182: my ($lonhost,$dom,$courses) = @_;
! 183: my @domains = &Apache::lonnet::current_machine_domains();
! 184: my @ids=&Apache::lonnet::current_machine_ids();
! 185: my $domain = &Apache::lonnet::host_domain($lonhost);
! 186:
! 187: #
! 188: # If user's current role is domain coordinator, domain of courses/communities
! 189: # to be shown needs to be domain being coordinated.
! 190: #
! 191: if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
! 192: $domain = $Apache::lonnet::env{'request.role.domain'};
! 193: unless ($dom eq $domain) {
! 194: my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
! 195: print('<p class="LC_error">'.
! 196: &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
! 197: '</p>'."\n".
! 198: '<p class="LC_info">'.
! 199: &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
! 200: '<a href="/cgi-bin/quotacheck.pl?domain='.$domain.'">'.
! 201: $otherdomdesc.'</a>').
! 202: '</p>');
! 203: return;
! 204: }
! 205: } else {
! 206: unless (grep(/^\Q$dom\E/,@domains)) {
! 207: print('<p class="LC_error">'.
! 208: &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
! 209: '</p>');
! 210: return;
! 211: }
! 212: }
! 213: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
! 214: my @showcourses;
! 215: if (ref($courses) eq 'ARRAY') {
! 216: @showcourses = @{$courses};
! 217: } else {
! 218: my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
! 219: if (keys(%courseshash)) {
! 220: @showcourses = keys(%courseshash);
! 221: }
! 222: }
! 223: if (@showcourses) {
! 224: print(&Apache::loncommon::start_data_table().
! 225: &Apache::loncommon::start_data_table_header_row().
! 226: '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
! 227: '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
! 228: '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
! 229: '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
! 230: '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
! 231: '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
! 232: &Apache::loncommon::end_data_table_header_row());
! 233: foreach my $cid (@showcourses) {
! 234: my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
! 235: my $cdesc = $courseinfo{'description'};
! 236: my $cnum = $courseinfo{'num'};
! 237: my $chome = $courseinfo{'home'};
! 238: my $crstype = $courseinfo{'type'};
! 239: if ($crstype eq '') {
! 240: if ($cnum =~ /^$LONCAPA::match_community$/) {
! 241: $crstype = 'Community';
! 242: } else {
! 243: $crstype = 'Course';
! 244: }
! 245: }
! 246: my $instcode = $courseinfo{'internal.coursecode'};
! 247: my $quota = $courseinfo{'internal.uploadquota'};
! 248: $quota =~ s/[^\d\.]+//g;
! 249: my $quotatype = 'unofficial';
! 250: if ($crstype eq 'Community') {
! 251: $quotatype = 'community';
! 252: } elsif ($courseinfo{'internal.coursecode'}) {
! 253: $quotatype = 'official';
! 254: } elsif ($courseinfo{'internal.textbook'}) {
! 255: $quotatype = 'textbook';
! 256: }
! 257: if ($quota eq '') {
! 258: $quota = $domdefs{$crstype.'quota'};
! 259: }
! 260: $quota =~ s/[^\d\.]+//g;
! 261: if ($quota eq '') {
! 262: $quota = 500;
! 263: }
! 264: my $current_disk_usage = 0;
! 265: if (grep(/^\Q$chome\E$/,@ids)) {
! 266: my $dir = &propath($dom,$cnum).'/userfiles/';
! 267: foreach my $subdir ('docs','supplemental') {
! 268: my $ududir = "$dir/$subdir";
! 269: my $total_size=0;
! 270: my $code=sub {
! 271: if (-d $_) { return;}
! 272: $total_size+=(stat($_))[7];
! 273: };
! 274: chdir($ududir);
! 275: find($code,$ududir);
! 276: $total_size=int($total_size/(1024*1024));
! 277: $current_disk_usage += $total_size;
! 278: }
! 279: } else {
! 280: foreach my $subdir ('docs','supplemental') {
! 281: $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
! 282: }
! 283: }
! 284: my $percent;
! 285: if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
! 286: $percent = 100.0;
! 287: } else {
! 288: $percent = 100*($current_disk_usage/$quota);
! 289: }
! 290: $current_disk_usage = sprintf("%.0f",$current_disk_usage);
! 291: $quota = sprintf("%.0f",$quota);
! 292: $percent = sprintf("%.0f",$percent);
! 293: print(&Apache::loncommon::start_data_table_row().
! 294: '<td>'.$quotatype.'</td>'.
! 295: '<td>'.$cdesc.'</td>'.
! 296: '<td>'.$instcode.'</td>'.
! 297: '<td>'.$quota.'</td>'.
! 298: '<td>'.$current_disk_usage.'</td>'.
! 299: '<td>'.$percent.'</td>'.
! 300: &Apache::loncommon::end_data_table_row()
! 301: );
! 302: }
! 303: print(&Apache::loncommon::end_data_table().'<br /><br />');
! 304: } else {
! 305: print(&Apache::lonlocal::mt('No courses match search criteria.'));
! 306: }
! 307: return;
! 308: }
! 309:
! 310: sub get_filters {
! 311: my ($dom,$params) = @_;
! 312: my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
! 313: 'ownerdomfilter','coursefilter','sincefilter');
! 314: # created filter
! 315: my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
! 316: if ($loncaparev ne 'unknown_cmd') {
! 317: push(@filterlist,'createdfilter');
! 318: }
! 319: my %filter;
! 320: foreach my $item (@filterlist) {
! 321: $filter{$item} = '';
! 322: }
! 323: if (ref($params) eq 'HASH') {
! 324: foreach my $item (@filterlist) {
! 325: $filter{$item} = $params->{$item};
! 326: }
! 327: }
! 328: return (\@filterlist,\%filter);
! 329: }
! 330:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to quotacheck.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi