Annotation of loncom/cgi/quotacheck.pl, revision 1.5
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: #
1.5 ! musolffc 9: # $Id: quotacheck.pl,v 1.4 2014/07/31 15:45:31 musolffc Exp $
1.1 raeburn 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:
1.3 musolffc 54: my $script = "/cgi-bin/quotacheck.pl";
55:
1.1 raeburn 56: print &LONCAPA::loncgi::cgi_header('text/html',1);
57: &main($lonhost);
58:
59: sub main {
60: my ($lonhost) = @_;
61: if ($lonhost eq '') {
62: &Apache::lonlocal::get_language_handle();
63: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 64: ({href=>$script,
1.1 raeburn 65: text=>"Content disk usage"});
66: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
67: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
68: '<p class="LC_error">'.
69: &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
70: '</p>'
71: &Apache::loncommon::end_page());
72: return;
73: }
74: if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
75: &LONCAPA::loncgi::check_cookie_and_load_env();
76: } else {
77: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
78: &Apache::lonlocal::get_language_handle();
79: print(&LONCAPA::loncgi::missing_cookie_msg());
80: return;
81: }
82: if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
83: &Apache::lonlocal::get_language_handle();
84: print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
85: return;
86: }
87: }
88: my (%gets,%posted,$reqdom,$crstype,%params);
89:
90: #
91: # Get domain -- if this is for an authenticated user (i.e., not IP-based access)
92: # Set domain in the order (a) value of fixeddom form element, if submitted
93: # (b) value of domain item in query string
94: # (c) default login domain for current server
95: #
96: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
97: my $q = CGI->new;
98: %params = $q->Vars;
99: $crstype = 'Course';
100: if ($params{'type'} eq 'Community') {
101: $crstype = $params{'type'};
102: }
1.5 ! musolffc 103: if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
1.1 raeburn 104: }
105: if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
106: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
107: if (ref($gets{'domain'}) eq 'ARRAY') {
108: $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
109: if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
110: my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
111: unless ($domdesc eq '') {
112: $reqdom = $gets{'domain'}->[0];
113: }
114: }
115: }
116: }
117: if ($reqdom eq '') {
118: $reqdom = &Apache::lonnet::default_login_domain();
119: }
120:
121: &Apache::lonlocal::get_language_handle();
122: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 123: ({href=>$script."?domain=$reqdom",
1.1 raeburn 124: text=>"Content disk usage"});
1.5 ! musolffc 125: if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
1.1 raeburn 126: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 127: ({href=>$script."?domain=$reqdom",
1.1 raeburn 128: text=>"Result"});
129: }
130: my $domdesc = &Apache::lonnet::domain($reqdom,'description');
1.4 musolffc 131: my $starthash = {
132: add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
133: };
134: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
1.1 raeburn 135: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
136: '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
137: '<h3>'.$domdesc.'</h3>');
1.5 ! musolffc 138: my $changejs = <<"ENDSCRIPT";
! 139: <script>
! 140: function changeSort(sortby) {
! 141: document.filterpicker.sortby.value = sortby;
! 142: if (('$params{'sortby'}' == sortby) && ('$params{'sortorder'}' != 'rev')) {
! 143: document.filterpicker.sortorder.value = 'rev';
! 144: }
! 145: document.filterpicker.submit();
! 146: }
! 147: </script>
! 148: ENDSCRIPT
! 149:
! 150: print($changejs);
1.1 raeburn 151:
152: #
153: # If this is for an authenticated user (i.e., not IP-based access)
154: # create display to choose filters to restrict courses/communities displayed
155: # (e.g., recent activity, recently created, institutional code, course owner etc.)
156: #
157:
158: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
159: my ($numtitles,@codetitles);
160: print(&Apache::loncommon::js_changer());
161: my ($filterlist,$filter) = &get_filters($reqdom,\%params);
162: $Apache::lonnet::env{'form.official'} = $params{'official'};
163: if ($params{'official'}) {
164: my @standardnames = &Apache::loncommon::get_standard_codeitems();
165: pop(@standardnames);
166: foreach my $item (@standardnames) {
167: if ($params{'official'} eq 'on') {
168: $Apache::lonnet::env{'form.'.$item} = $params{$item};
169: } else {
170: $Apache::lonnet::env{'form.'.$item} = 0;
171: }
172: }
173: $Apache::lonnet::env{'form.state'} = $params{'state'};
174: }
175: print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
1.3 musolffc 176: $script,\$numtitles,
1.1 raeburn 177: 'quotacheck',undef,undef,undef,
178: \@codetitles,$reqdom,'quotacheck',$reqdom));
1.5 ! musolffc 179: if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
1.1 raeburn 180: if ($params{'official'} eq 'on') {
181: $Apache::lonnet::env{'form.state'} = $params{'state'};
182: }
1.5 ! musolffc 183: # Sort by course title (cdesc) as default, not reversed
! 184: my $sortby = $params{'sortby'};
! 185: unless ($sortby =~ m{^(quota|current_disk_usage|percent|quotatype|instcode)$}) {
! 186: $sortby = 'cdesc';
! 187: }
! 188: my $sortorder;
! 189: if ($params{'sortorder'} eq 'rev') { $sortorder = 'rev'; }
! 190:
1.1 raeburn 191: my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
192: undef,undef,undef,\@codetitles);
193: my @showcourses = keys(%courses);
1.5 ! musolffc 194: &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder);
1.1 raeburn 195: }
1.5 ! musolffc 196:
1.1 raeburn 197: print(&Apache::loncommon::end_page());
198: return;
199: }
200: &print_usage($lonhost,$reqdom);
201: print(&Apache::loncommon::end_page());
202: return;
203: }
204:
205: sub print_usage {
1.5 ! musolffc 206: my ($lonhost,$dom,$courses,$sortby,$sortorder) = @_;
1.1 raeburn 207: my @domains = &Apache::lonnet::current_machine_domains();
208: my @ids=&Apache::lonnet::current_machine_ids();
209: my $domain = &Apache::lonnet::host_domain($lonhost);
210:
211: #
212: # If user's current role is domain coordinator, domain of courses/communities
213: # to be shown needs to be domain being coordinated.
214: #
215: if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
216: $domain = $Apache::lonnet::env{'request.role.domain'};
217: unless ($dom eq $domain) {
218: my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
219: print('<p class="LC_error">'.
220: &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
221: '</p>'."\n".
222: '<p class="LC_info">'.
223: &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
1.3 musolffc 224: '<a href="'.$script.'?domain='.$domain.'">'.
1.1 raeburn 225: $otherdomdesc.'</a>').
226: '</p>');
227: return;
228: }
229: } else {
230: unless (grep(/^\Q$dom\E/,@domains)) {
231: print('<p class="LC_error">'.
232: &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
233: '</p>');
234: return;
235: }
236: }
237: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
238: my @showcourses;
239: if (ref($courses) eq 'ARRAY') {
240: @showcourses = @{$courses};
241: } else {
242: my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
243: if (keys(%courseshash)) {
244: @showcourses = keys(%courseshash);
245: }
246: }
1.5 ! musolffc 247:
1.1 raeburn 248: if (@showcourses) {
249: print(&Apache::loncommon::start_data_table().
1.5 ! musolffc 250: &Apache::loncommon::start_data_table_header_row()
! 251: .'<th><a href="javascript:changeSort('."'quotatype'".')">'
! 252: .&Apache::lonlocal::mt('Course Type')
! 253: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 254: .'<th><a href="javascript:changeSort('."'cdesc'".')">'
! 255: .&Apache::lonlocal::mt('Course Title')
! 256: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 257: .'<th><a href="javascript:changeSort('."'instcode'".')">'
! 258: .&Apache::lonlocal::mt('Institutional Code')
! 259: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 260: .'<th><a href="javascript:changeSort('."'quota'".')">'
! 261: .&Apache::lonlocal::mt('Quota (MB)')
! 262: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 263: .'<th><a href="javascript:changeSort('."'current_disk_usage'".')">'
! 264: .&Apache::lonlocal::mt('Usage (MB)')
! 265: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 266: .'<th><a href="javascript:changeSort('."'percent'".')">'
! 267: .&Apache::lonlocal::mt('Percent usage')
! 268: .'<span class="LC_fontsize_small"> ▼</span></a></th>'
! 269: .&Apache::loncommon::end_data_table_header_row());
! 270:
! 271: my $usagehash = {}; # Sortable hash of courses
1.1 raeburn 272: foreach my $cid (@showcourses) {
273: my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
274: my $cdesc = $courseinfo{'description'};
275: my $cnum = $courseinfo{'num'};
276: my $chome = $courseinfo{'home'};
277: my $crstype = $courseinfo{'type'};
278: if ($crstype eq '') {
279: if ($cnum =~ /^$LONCAPA::match_community$/) {
280: $crstype = 'Community';
281: } else {
282: $crstype = 'Course';
283: }
284: }
285: my $instcode = $courseinfo{'internal.coursecode'};
286: my $quota = $courseinfo{'internal.uploadquota'};
287: $quota =~ s/[^\d\.]+//g;
288: my $quotatype = 'unofficial';
289: if ($crstype eq 'Community') {
290: $quotatype = 'community';
291: } elsif ($courseinfo{'internal.coursecode'}) {
292: $quotatype = 'official';
293: } elsif ($courseinfo{'internal.textbook'}) {
294: $quotatype = 'textbook';
295: }
296: if ($quota eq '') {
297: $quota = $domdefs{$crstype.'quota'};
298: }
299: $quota =~ s/[^\d\.]+//g;
300: if ($quota eq '') {
301: $quota = 500;
302: }
303: my $current_disk_usage = 0;
304: if (grep(/^\Q$chome\E$/,@ids)) {
305: my $dir = &propath($dom,$cnum).'/userfiles/';
306: foreach my $subdir ('docs','supplemental') {
307: my $ududir = "$dir/$subdir";
308: my $total_size=0;
309: my $code=sub {
310: if (-d $_) { return;}
311: $total_size+=(stat($_))[7];
312: };
313: chdir($ududir);
314: find($code,$ududir);
315: $total_size=int($total_size/(1024*1024));
316: $current_disk_usage += $total_size;
317: }
318: } else {
319: foreach my $subdir ('docs','supplemental') {
320: $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
321: }
322: }
323: my $percent;
324: if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
325: $percent = 100.0;
326: } else {
327: $percent = 100*($current_disk_usage/$quota);
328: }
329: $current_disk_usage = sprintf("%.0f",$current_disk_usage);
330: $quota = sprintf("%.0f",$quota);
331: $percent = sprintf("%.0f",$percent);
1.5 ! musolffc 332:
! 333: # Enter sortable data into hash
! 334: $usagehash->{ $cid } = {
! 335: "quotatype" => $quotatype,
! 336: "cdesc" => $cdesc,
! 337: "instcode" => $instcode,
! 338: "quota" => $quota,
! 339: "current_disk_usage" => $current_disk_usage,
! 340: "percent" => $percent,
! 341: };
! 342: }
! 343:
! 344: # Sort courses by $sortby. "cdesc" is the default.
! 345: my @sorted_courses;
! 346: if ($sortby =~ m{^(quota|current_disk_usage|percent)$}) {
! 347: # Numerical fields
! 348: if ($sortorder eq "rev") {
! 349: @sorted_courses = sort {
! 350: $usagehash->{$a}->{$sortby} <=> $usagehash->{$b}->{$sortby}
! 351: or
! 352: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
! 353: } (keys(%{$usagehash}));
! 354: } else {
! 355: @sorted_courses = sort {
! 356: $usagehash->{$b}->{$sortby} <=> $usagehash->{$a}->{$sortby}
! 357: or
! 358: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
! 359: } (keys(%{$usagehash}));
! 360: }
! 361: } elsif ($sortby =~ m{^(cdesc|quotatype|instcode)$}) {
! 362: # String fields
! 363: if ($sortorder eq "rev") {
! 364: @sorted_courses = sort {
! 365: uc($usagehash->{$b}->{$sortby}) cmp uc($usagehash->{$a}->{$sortby})
! 366: or
! 367: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
! 368: } (keys(%{$usagehash}));
! 369: } else {
! 370: @sorted_courses = sort {
! 371: uc($usagehash->{$a}->{$sortby}) cmp uc($usagehash->{$b}->{$sortby})
! 372: or
! 373: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
! 374: } (keys(%{$usagehash}));
! 375: }
! 376: }
! 377:
! 378: # Print data for each course.
! 379: foreach my $course (@sorted_courses) {
1.1 raeburn 380: print(&Apache::loncommon::start_data_table_row().
1.5 ! musolffc 381: '<td>'.$usagehash->{$course}->{"quotatype"}.'</td>'.
! 382: '<td>'.$usagehash->{$course}->{"cdesc"}.'</td>'.
! 383: '<td>'.$usagehash->{$course}->{"instcode"}.'</td>'.
! 384: '<td>'.$usagehash->{$course}->{"quota"}.'</td>'.
! 385: '<td>'.$usagehash->{$course}->{"current_disk_usage"}.'</td>'.
! 386: '<td>'.$usagehash->{$course}->{"percent"}.'</td>'.
1.1 raeburn 387: &Apache::loncommon::end_data_table_row()
388: );
389: }
390: print(&Apache::loncommon::end_data_table().'<br /><br />');
391: } else {
392: print(&Apache::lonlocal::mt('No courses match search criteria.'));
393: }
394: return;
395: }
396:
397: sub get_filters {
398: my ($dom,$params) = @_;
399: my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
400: 'ownerdomfilter','coursefilter','sincefilter');
401: # created filter
402: my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
403: if ($loncaparev ne 'unknown_cmd') {
404: push(@filterlist,'createdfilter');
405: }
406: my %filter;
407: foreach my $item (@filterlist) {
408: $filter{$item} = '';
409: }
410: if (ref($params) eq 'HASH') {
411: foreach my $item (@filterlist) {
412: $filter{$item} = $params->{$item};
413: }
414: }
415: return (\@filterlist,\%filter);
416: }
417:
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