File:
[LON-CAPA] /
loncom /
cgi /
quotacheck.pl
Revision
1.6:
download - view:
text,
annotated -
select for diffs
Tue Aug 5 19:32:19 2014 UTC (10 years ago) by
musolffc
Branches:
MAIN
CVS tags:
HEAD
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
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.6 2014/08/05 19:32:19 musolffc 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: my $script = "/cgi-bin/quotacheck.pl";
55:
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
64: ({href=>$script,
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: }
103: if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
104: unless ($params{'sortby'}) { $params{'sortby'} = 'cdesc'; }
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=>$script."?domain=$reqdom",
125: text=>"Content disk usage"});
126: if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
127: &Apache::lonhtmlcommon::add_breadcrumb
128: ({href=>$script."?domain=$reqdom",
129: text=>"Result"});
130: }
131: my $domdesc = &Apache::lonnet::domain($reqdom,'description');
132: my $starthash = {
133: add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
134: };
135: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
136: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
137: '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
138: '<h3>'.$domdesc.'</h3>');
139: my $changejs = <<"ENDSCRIPT";
140: <script>
141: function changeSort(sortby) {
142: document.filterpicker.sortby.value = sortby;
143: if (('$params{'sortby'}' == sortby) && ('$params{'sortorder'}' != 'rev')) {
144: document.filterpicker.sortorder.value = 'rev';
145: }
146: document.filterpicker.submit();
147: }
148: </script>
149: ENDSCRIPT
150:
151: print($changejs);
152:
153: #
154: # If this is for an authenticated user (i.e., not IP-based access)
155: # create display to choose filters to restrict courses/communities displayed
156: # (e.g., recent activity, recently created, institutional code, course owner etc.)
157: #
158:
159: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
160: my ($numtitles,@codetitles);
161: print(&Apache::loncommon::js_changer());
162: my ($filterlist,$filter) = &get_filters($reqdom,\%params);
163: $Apache::lonnet::env{'form.official'} = $params{'official'};
164: if ($params{'official'}) {
165: my @standardnames = &Apache::loncommon::get_standard_codeitems();
166: pop(@standardnames);
167: foreach my $item (@standardnames) {
168: if ($params{'official'} eq 'on') {
169: $Apache::lonnet::env{'form.'.$item} = $params{$item};
170: } else {
171: $Apache::lonnet::env{'form.'.$item} = 0;
172: }
173: }
174: $Apache::lonnet::env{'form.state'} = $params{'state'};
175: }
176: print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
177: $script,\$numtitles,
178: 'quotacheck',undef,undef,undef,
179: \@codetitles,$reqdom,'quotacheck',$reqdom));
180: if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
181: if ($params{'official'} eq 'on') {
182: $Apache::lonnet::env{'form.state'} = $params{'state'};
183: }
184: # Sort by course title (cdesc) as default, not reversed
185: my $sortby = $params{'sortby'};
186: unless ($sortby =~ m{^(quota|current_disk_usage|percent|quotatype|instcode)$}) {
187: $sortby = 'cdesc';
188: }
189: my $sortorder;
190: if ($params{'sortorder'} eq 'rev') { $sortorder = 'rev'; }
191:
192: my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
193: undef,undef,undef,\@codetitles);
194: my @showcourses = keys(%courses);
195: &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder);
196: }
197:
198: print(&Apache::loncommon::end_page());
199: return;
200: }
201: &print_usage($lonhost,$reqdom);
202: print(&Apache::loncommon::end_page());
203: return;
204: }
205:
206: sub print_usage {
207: my ($lonhost,$dom,$courses,$sortby,$sortorder) = @_;
208: my @domains = &Apache::lonnet::current_machine_domains();
209: my @ids=&Apache::lonnet::current_machine_ids();
210: my $domain = &Apache::lonnet::host_domain($lonhost);
211:
212: #
213: # If user's current role is domain coordinator, domain of courses/communities
214: # to be shown needs to be domain being coordinated.
215: #
216: if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
217: $domain = $Apache::lonnet::env{'request.role.domain'};
218: unless ($dom eq $domain) {
219: my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
220: print('<p class="LC_error">'.
221: &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
222: '</p>'."\n".
223: '<p class="LC_info">'.
224: &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
225: '<a href="'.$script.'?domain='.$domain.'">'.
226: $otherdomdesc.'</a>').
227: '</p>');
228: return;
229: }
230: } else {
231: unless (grep(/^\Q$dom\E/,@domains)) {
232: print('<p class="LC_error">'.
233: &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
234: '</p>');
235: return;
236: }
237: }
238: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
239: my @showcourses;
240: if (ref($courses) eq 'ARRAY') {
241: @showcourses = @{$courses};
242: } else {
243: my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
244: if (keys(%courseshash)) {
245: @showcourses = keys(%courseshash);
246: }
247: }
248:
249: if (@showcourses) {
250: # Order in which columns are displayed from left to right
251: my @order = ('quotatype','cdesc','instcode','quota',
252: 'current_disk_usage','percent');
253:
254: # Up and down arrows to indicate sort order
255: my @arrows = (' ▲',' ▼','');
256:
257: # Default sort order and column title
258: my %columns = (
259: quotatype => {
260: order => 'ascending',
261: text => &Apache::lonlocal::mt('Course Type'),
262: },
263: cdesc => {
264: order => 'ascending',
265: text => &Apache::lonlocal::mt('Course Title'),
266: },
267: instcode => {
268: order => 'ascending',
269: text => &Apache::lonlocal::mt('Institutional Code'),
270: },
271: quota => {
272: order => 'descending',
273: text => &Apache::lonlocal::mt('Quota (MB)'),
274: },
275: current_disk_usage => {
276: order => 'descending',
277: text => &Apache::lonlocal::mt('Usage (MB)'),
278: },
279: percent => {
280: order => 'descending',
281: text => &Apache::lonlocal::mt('Percent usage'),
282: },
283: );
284:
285: # Print column headers
286: my $output = '';
287: foreach my $key (@order) {
288: my $idx;
289: # Append an up or down arrow to sorted column
290: if ($sortby eq $key) {
291: $idx = ($columns{$key}{order} eq 'ascending') ? 0:1;
292: if ($sortorder eq 'rev') { $idx ++; }
293: $idx = $idx%2;
294: } else { $idx = 2; } # No arrow if column not sorted
295: $output .= '<th><a href="javascript:changeSort('
296: ."'$key'".');">'.$columns{$key}{text}
297: .$arrows[$idx].'</a></th>';
298: }
299: print(&Apache::loncommon::start_data_table()
300: .&Apache::loncommon::start_data_table_header_row().$output
301: .&Apache::loncommon::end_data_table_header_row());
302:
303: my $usagehash = {}; # Sortable hash of courses
304: foreach my $cid (@showcourses) {
305: my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
306: my $cdesc = $courseinfo{'description'};
307: my $cnum = $courseinfo{'num'};
308: my $chome = $courseinfo{'home'};
309: my $crstype = $courseinfo{'type'};
310: if ($crstype eq '') {
311: if ($cnum =~ /^$LONCAPA::match_community$/) {
312: $crstype = 'Community';
313: } else {
314: $crstype = 'Course';
315: }
316: }
317: my $instcode = $courseinfo{'internal.coursecode'};
318: my $quota = $courseinfo{'internal.uploadquota'};
319: $quota =~ s/[^\d\.]+//g;
320: my $quotatype = 'unofficial';
321: if ($crstype eq 'Community') {
322: $quotatype = 'community';
323: } elsif ($courseinfo{'internal.coursecode'}) {
324: $quotatype = 'official';
325: } elsif ($courseinfo{'internal.textbook'}) {
326: $quotatype = 'textbook';
327: }
328: if ($quota eq '') {
329: $quota = $domdefs{$crstype.'quota'};
330: }
331: $quota =~ s/[^\d\.]+//g;
332: if ($quota eq '') {
333: $quota = 500;
334: }
335: my $current_disk_usage = 0;
336: if (grep(/^\Q$chome\E$/,@ids)) {
337: my $dir = &propath($dom,$cnum).'/userfiles/';
338: foreach my $subdir ('docs','supplemental') {
339: my $ududir = "$dir/$subdir";
340: my $total_size=0;
341: my $code=sub {
342: if (-d $_) { return;}
343: $total_size+=(stat($_))[7];
344: };
345: chdir($ududir);
346: find($code,$ududir);
347: $total_size=int($total_size/(1024*1024));
348: $current_disk_usage += $total_size;
349: }
350: } else {
351: foreach my $subdir ('docs','supplemental') {
352: $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
353: }
354: }
355: my $percent;
356: if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
357: $percent = 100.0;
358: } else {
359: $percent = 100*($current_disk_usage/$quota);
360: }
361: $current_disk_usage = sprintf("%.0f",$current_disk_usage);
362: $quota = sprintf("%.0f",$quota);
363: $percent = sprintf("%.0f",$percent);
364:
365: # Enter sortable data into hash
366: $usagehash->{ $cid } = {
367: "quotatype" => $quotatype,
368: "cdesc" => $cdesc,
369: "instcode" => $instcode,
370: "quota" => $quota,
371: "current_disk_usage" => $current_disk_usage,
372: "percent" => $percent,
373: };
374: }
375:
376: # Sort courses by $sortby. "cdesc" is the default.
377: my @sorted_courses;
378: if ($sortby =~ m{^(quota|current_disk_usage|percent)$}) {
379: # Numerical fields
380: if ($sortorder eq "rev") {
381: @sorted_courses = sort {
382: $usagehash->{$a}->{$sortby} <=> $usagehash->{$b}->{$sortby}
383: or
384: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
385: } (keys(%{$usagehash}));
386: } else {
387: @sorted_courses = sort {
388: $usagehash->{$b}->{$sortby} <=> $usagehash->{$a}->{$sortby}
389: or
390: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
391: } (keys(%{$usagehash}));
392: }
393: } elsif ($sortby =~ m{^(cdesc|quotatype|instcode)$}) {
394: # String fields
395: if ($sortorder eq "rev") {
396: @sorted_courses = sort {
397: uc($usagehash->{$b}->{$sortby}) cmp uc($usagehash->{$a}->{$sortby})
398: or
399: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
400: } (keys(%{$usagehash}));
401: } else {
402: @sorted_courses = sort {
403: uc($usagehash->{$a}->{$sortby}) cmp uc($usagehash->{$b}->{$sortby})
404: or
405: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
406: } (keys(%{$usagehash}));
407: }
408: }
409:
410: # Print data for each course.
411: foreach my $course (@sorted_courses) {
412: print(&Apache::loncommon::start_data_table_row().
413: '<td>'.$usagehash->{$course}->{"quotatype"}.'</td>'.
414: '<td>'.$usagehash->{$course}->{"cdesc"}.'</td>'.
415: '<td>'.$usagehash->{$course}->{"instcode"}.'</td>'.
416: '<td>'.$usagehash->{$course}->{"quota"}.'</td>'.
417: '<td>'.$usagehash->{$course}->{"current_disk_usage"}.'</td>'.
418: '<td>'.$usagehash->{$course}->{"percent"}.'</td>'.
419: &Apache::loncommon::end_data_table_row()
420: );
421: }
422: print(&Apache::loncommon::end_data_table().'<br /><br />');
423: } else {
424: print(&Apache::lonlocal::mt('No courses match search criteria.'));
425: }
426: return;
427: }
428:
429: sub get_filters {
430: my ($dom,$params) = @_;
431: my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
432: 'ownerdomfilter','coursefilter','sincefilter');
433: # created filter
434: my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
435: if ($loncaparev ne 'unknown_cmd') {
436: push(@filterlist,'createdfilter');
437: }
438: my %filter;
439: foreach my $item (@filterlist) {
440: $filter{$item} = '';
441: }
442: if (ref($params) eq 'HASH') {
443: foreach my $item (@filterlist) {
444: $filter{$item} = $params->{$item};
445: }
446: }
447: return (\@filterlist,\%filter);
448: }
449:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>