Annotation of loncom/cgi/quotacheck.pl, revision 1.8
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.8 ! raeburn 9: # $Id: quotacheck.pl,v 1.7 2014/08/23 18:54:45 raeburn 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();
1.8 ! raeburn 39: use Apache::courseclassifier();
1.1 raeburn 40: use Apache::lonlocal();
41: use LONCAPA::Configuration();
42: use LONCAPA::loncgi();
43: use LONCAPA::lonauthcgi();
44: use File::Find;
45: use CGI qw(:standard);
46: use LONCAPA;
47:
48: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
49: my $lonhost;
50: if (ref($perlvar) eq 'HASH') {
51: $lonhost = $perlvar->{'lonHostID'};
52: }
53: undef($perlvar);
54:
1.3 musolffc 55: my $script = "/cgi-bin/quotacheck.pl";
56:
1.1 raeburn 57: print &LONCAPA::loncgi::cgi_header('text/html',1);
58: &main($lonhost);
59:
60: sub main {
61: my ($lonhost) = @_;
62: if ($lonhost eq '') {
63: &Apache::lonlocal::get_language_handle();
64: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 65: ({href=>$script,
1.1 raeburn 66: text=>"Content disk usage"});
67: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas').
68: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
69: '<p class="LC_error">'.
70: &Apache::lonlocal::mt("Error: could not determine server's LON-CAPA hostID.").
71: '</p>'
72: &Apache::loncommon::end_page());
73: return;
74: }
75: if (&LONCAPA::lonauthcgi::check_ipbased_access('diskusage')) {
76: &LONCAPA::loncgi::check_cookie_and_load_env();
77: } else {
78: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
79: &Apache::lonlocal::get_language_handle();
80: print(&LONCAPA::loncgi::missing_cookie_msg());
81: return;
82: }
83: if (!&LONCAPA::lonauthcgi::can_view('diskusage')) {
84: &Apache::lonlocal::get_language_handle();
85: print(&LONCAPA::lonauthcgi::unauthorized_msg('diskusage'));
86: return;
87: }
88: }
1.8 ! raeburn 89: my ($reqdom,$crstype,$type,%params);
1.1 raeburn 90:
91: #
92: # Get domain -- if this is for an authenticated user (i.e., not IP-based access)
93: # Set domain in the order (a) value of fixeddom form element, if submitted
94: # (b) value of domain item in query string
95: # (c) default login domain for current server
96: #
97: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
98: my $q = CGI->new;
99: %params = $q->Vars;
100: $crstype = 'Course';
101: if ($params{'type'} eq 'Community') {
102: $crstype = $params{'type'};
1.8 ! raeburn 103: $type = $crstype;
1.1 raeburn 104: }
1.5 musolffc 105: if ($params{'fixeddom'}) { $reqdom = $params{'fixeddom'} }
1.1 raeburn 106: }
107: if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
1.8 ! raeburn 108: my %gets;
1.1 raeburn 109: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
110: if (ref($gets{'domain'}) eq 'ARRAY') {
111: $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
112: if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
113: my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
114: unless ($domdesc eq '') {
115: $reqdom = $gets{'domain'}->[0];
116: }
117: }
118: }
1.8 ! raeburn 119: if (($crstype eq '') && (ref($gets{'type'}) eq 'ARRAY')) {
! 120: $gets{'type'}->[0] =~ s/^\s+|\s+$//g;
! 121: if (lc($gets{'type'}->[0]) eq 'community') {
! 122: $crstype = 'Community';
! 123: } elsif ($gets{'type'}->[0] =~ /^(un|)official$/) {
! 124: $crstype = $gets{'type'}->[0];
! 125: }
! 126: }
! 127: if (($params{'sortby'} eq '') && (ref($gets{'sortby'}) eq 'ARRAY')){
! 128: $gets{'sortby'}->[0] =~ s/^\s+|\s+$//g;
! 129: if ($gets{'sortby'}->[0] =~ /^(quota|current_disk_usage|percent|quotatype|instcode)$/) {
! 130: $params{'sortby'} = $1;
! 131: }
! 132: }
! 133: if (($params{'sortorder'} eq '') && (ref($gets{'sortorder'}) eq 'ARRAY')){
! 134: $gets{'sortorder'}->[0] =~ s/^\s+|\s+$//g;
! 135: if ($gets{'sortorder'}->[0] eq 'rev') {
! 136: $params{'sortorder'} = $gets{'sortorder'}->[0];
! 137: }
! 138: }
1.1 raeburn 139: }
140: if ($reqdom eq '') {
141: $reqdom = &Apache::lonnet::default_login_domain();
142: }
1.8 ! raeburn 143: my $knownuser;
! 144: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
! 145: $knownuser = 1;
! 146: }
1.1 raeburn 147: &Apache::lonlocal::get_language_handle();
148: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 149: ({href=>$script."?domain=$reqdom",
1.1 raeburn 150: text=>"Content disk usage"});
1.8 ! raeburn 151: if ((($params{'gosearch'}) || ($params{'sortby'})) && ($knownuser)) {
1.1 raeburn 152: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 153: ({href=>$script."?domain=$reqdom",
1.1 raeburn 154: text=>"Result"});
155: }
156: my $domdesc = &Apache::lonnet::domain($reqdom,'description');
1.8 ! raeburn 157: my $starthash;
! 158: unless ($crstype eq 'Community') {
! 159: $starthash = {
! 160: add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
! 161: };
! 162: }
1.4 musolffc 163: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
1.1 raeburn 164: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
165: '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
166: '<h3>'.$domdesc.'</h3>');
1.8 ! raeburn 167:
! 168: # Sort by course title (cdesc) as default, not reversed
! 169: my $sortby = $params{'sortby'};
! 170: unless ($sortby =~ m{^(quota|current_disk_usage|percent|quotatype|instcode)$}) {
! 171: $sortby = 'cdesc';
! 172: }
! 173: my $sortorder;
! 174: if ($params{'sortorder'} eq 'rev') { $sortorder = 'rev'; }
! 175:
! 176: #
! 177: # If this is for an authenticated user (i.e., not IP-based access)
! 178: # create display to choose filters to restrict courses/communities displayed
! 179: # (e.g., recent activity, recently created, institutional code, course owner etc.)
! 180: #
! 181:
! 182: if ($knownuser) {
! 183: print <<"ENDSCRIPT";
1.5 musolffc 184: <script>
185: function changeSort(sortby) {
186: document.filterpicker.sortby.value = sortby;
1.8 ! raeburn 187: if (('$sortby' == sortby) && ('$params{'sortorder'}' != 'rev')) {
! 188: document.filterpicker.sortorder.value = 'rev';
1.5 musolffc 189: }
190: document.filterpicker.submit();
191: }
192: </script>
193: ENDSCRIPT
1.1 raeburn 194: my ($numtitles,@codetitles);
195: print(&Apache::loncommon::js_changer());
196: my ($filterlist,$filter) = &get_filters($reqdom,\%params);
197: $Apache::lonnet::env{'form.official'} = $params{'official'};
198: if ($params{'official'}) {
199: my @standardnames = &Apache::loncommon::get_standard_codeitems();
200: pop(@standardnames);
201: foreach my $item (@standardnames) {
202: if ($params{'official'} eq 'on') {
203: $Apache::lonnet::env{'form.'.$item} = $params{$item};
1.8 ! raeburn 204: $type = 'official';
1.1 raeburn 205: } else {
206: $Apache::lonnet::env{'form.'.$item} = 0;
1.8 ! raeburn 207: $type = 'unofficial';
1.1 raeburn 208: }
209: }
210: $Apache::lonnet::env{'form.state'} = $params{'state'};
211: }
212: print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
1.3 musolffc 213: $script,\$numtitles,
1.1 raeburn 214: 'quotacheck',undef,undef,undef,
215: \@codetitles,$reqdom,'quotacheck',$reqdom));
1.5 musolffc 216: if ( ($params{'gosearch'}) || ($params{'sortby'}) ) {
1.1 raeburn 217: if ($params{'official'} eq 'on') {
218: $Apache::lonnet::env{'form.state'} = $params{'state'};
219: }
220: my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
221: undef,undef,undef,\@codetitles);
222: my @showcourses = keys(%courses);
1.8 ! raeburn 223: &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder,$type,
! 224: $knownuser,$script);
! 225: }
! 226: } else {
! 227: my ($instcodefilter,$regexpok,@showcourses);
! 228: $instcodefilter = '.';
! 229: if ($crstype eq '') {
! 230: $crstype = '.';
! 231: } elsif ($crstype =~ /^(un|)official$/) {
! 232: $type = $crstype;
! 233: my ($numtitles,@codetitles,%cat_items,%cat_titles,%cat_order);
! 234: (undef,undef,$numtitles) =
! 235: &Apache::courseclassifier::instcode_selectors_data($reqdom,'filterpicker',
! 236: \%cat_items,\@codetitles,
! 237: \%cat_titles,\%cat_order);
! 238: foreach my $item (@codetitles) {
! 239: $Apache::lonnet::env{'form.'.$item} = 0;
! 240: }
! 241: $instcodefilter =
! 242: &Apache::courseclassifier::instcode_search_str($reqdom,$numtitles,\@codetitles);
! 243: if ($crstype eq 'official') {
! 244: $regexpok = 1;
! 245: } elsif ($crstype eq 'unofficial') {
! 246: unless ($instcodefilter eq '') {
! 247: $regexpok = -1;
! 248: }
! 249: }
! 250: $crstype = 'Course';
1.1 raeburn 251: }
1.8 ! raeburn 252: my %courseshash = &Apache::lonnet::courseiddump($reqdom,'.',1,$instcodefilter,'.','.',
! 253: undef,undef,$crstype,$regexpok);
! 254: if (keys(%courseshash)) {
! 255: @showcourses = keys(%courseshash);
! 256: }
! 257: &print_usage($lonhost,$reqdom,\@showcourses,$sortby,$sortorder,$type,$knownuser,
! 258: $script);
1.1 raeburn 259: }
260: print(&Apache::loncommon::end_page());
261: return;
262: }
263:
264: sub print_usage {
1.8 ! raeburn 265: my ($lonhost,$dom,$courses,$sortby,$sortorder,$type,$knownuser,$script) = @_;
1.1 raeburn 266: my @domains = &Apache::lonnet::current_machine_domains();
267: my @ids=&Apache::lonnet::current_machine_ids();
268: my $domain = &Apache::lonnet::host_domain($lonhost);
269:
270: #
271: # If user's current role is domain coordinator, domain of courses/communities
272: # to be shown needs to be domain being coordinated.
273: #
274: if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
275: $domain = $Apache::lonnet::env{'request.role.domain'};
276: unless ($dom eq $domain) {
277: my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
278: print('<p class="LC_error">'.
279: &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
280: '</p>'."\n".
281: '<p class="LC_info">'.
282: &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
1.3 musolffc 283: '<a href="'.$script.'?domain='.$domain.'">'.
1.1 raeburn 284: $otherdomdesc.'</a>').
285: '</p>');
286: return;
287: }
288: } else {
289: unless (grep(/^\Q$dom\E/,@domains)) {
290: print('<p class="LC_error">'.
291: &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
292: '</p>');
293: return;
294: }
295: }
296: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
297: my @showcourses;
298: if (ref($courses) eq 'ARRAY') {
299: @showcourses = @{$courses};
300: } else {
301: my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
302: if (keys(%courseshash)) {
303: @showcourses = keys(%courseshash);
304: }
305: }
1.5 musolffc 306:
1.1 raeburn 307: if (@showcourses) {
1.6 musolffc 308: # Order in which columns are displayed from left to right
309: my @order = ('quotatype','cdesc','instcode','quota',
310: 'current_disk_usage','percent');
311:
312: # Up and down arrows to indicate sort order
313: my @arrows = (' ▲',' ▼','');
314:
315: # Default sort order and column title
316: my %columns = (
317: quotatype => {
318: order => 'ascending',
319: text => &Apache::lonlocal::mt('Course Type'),
320: },
321: cdesc => {
322: order => 'ascending',
323: text => &Apache::lonlocal::mt('Course Title'),
324: },
325: instcode => {
326: order => 'ascending',
327: text => &Apache::lonlocal::mt('Institutional Code'),
328: },
329: quota => {
330: order => 'descending',
331: text => &Apache::lonlocal::mt('Quota (MB)'),
332: },
333: current_disk_usage => {
334: order => 'descending',
335: text => &Apache::lonlocal::mt('Usage (MB)'),
336: },
337: percent => {
338: order => 'descending',
339: text => &Apache::lonlocal::mt('Percent usage'),
340: },
341: );
342:
343: # Print column headers
344: my $output = '';
345: foreach my $key (@order) {
1.8 ! raeburn 346: next if (($key eq 'instcode') && ($type ne 'official') && ($type ne ''));
1.6 musolffc 347: my $idx;
348: # Append an up or down arrow to sorted column
349: if ($sortby eq $key) {
350: $idx = ($columns{$key}{order} eq 'ascending') ? 0:1;
351: if ($sortorder eq 'rev') { $idx ++; }
352: $idx = $idx%2;
353: } else { $idx = 2; } # No arrow if column not sorted
1.8 ! raeburn 354: my $link = 'javascript:changeSort('."'$key'".');';
! 355: if (!$knownuser) {
! 356: $link = $script.'?domain='.$dom.'&sortby='.$key;
! 357: if ($type =~ /^((un|)official)|(C|c)ommunity/) {
! 358: $link .='&type='.$type;
! 359: }
! 360: if ($sortby eq $key) {
! 361: unless ($sortorder) {
! 362: $link .= '&sortorder=rev';
! 363: }
! 364: }
! 365: }
! 366: $output .= '<th><a href="'.$link.'"">'.$columns{$key}{text}
! 367: .$arrows[$idx].'</a></th>';
1.6 musolffc 368: }
369: print(&Apache::loncommon::start_data_table()
370: .&Apache::loncommon::start_data_table_header_row().$output
1.5 musolffc 371: .&Apache::loncommon::end_data_table_header_row());
372:
373: my $usagehash = {}; # Sortable hash of courses
1.1 raeburn 374: foreach my $cid (@showcourses) {
375: my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
376: my $cdesc = $courseinfo{'description'};
377: my $cnum = $courseinfo{'num'};
378: my $chome = $courseinfo{'home'};
379: my $crstype = $courseinfo{'type'};
380: if ($crstype eq '') {
381: if ($cnum =~ /^$LONCAPA::match_community$/) {
382: $crstype = 'Community';
383: } else {
384: $crstype = 'Course';
385: }
386: }
387: my $instcode = $courseinfo{'internal.coursecode'};
388: my $quota = $courseinfo{'internal.uploadquota'};
389: $quota =~ s/[^\d\.]+//g;
390: my $quotatype = 'unofficial';
391: if ($crstype eq 'Community') {
392: $quotatype = 'community';
393: } elsif ($courseinfo{'internal.coursecode'}) {
394: $quotatype = 'official';
395: } elsif ($courseinfo{'internal.textbook'}) {
396: $quotatype = 'textbook';
397: }
398: if ($quota eq '') {
1.7 raeburn 399: $quota = $domdefs{$quotatype.'quota'};
1.1 raeburn 400: }
401: $quota =~ s/[^\d\.]+//g;
402: if ($quota eq '') {
403: $quota = 500;
404: }
405: my $current_disk_usage = 0;
406: if (grep(/^\Q$chome\E$/,@ids)) {
407: my $dir = &propath($dom,$cnum).'/userfiles/';
408: foreach my $subdir ('docs','supplemental') {
409: my $ududir = "$dir/$subdir";
410: my $total_size=0;
411: my $code=sub {
412: if (-d $_) { return;}
413: $total_size+=(stat($_))[7];
414: };
415: chdir($ududir);
416: find($code,$ududir);
417: $total_size=int($total_size/(1024*1024));
418: $current_disk_usage += $total_size;
419: }
420: } else {
421: foreach my $subdir ('docs','supplemental') {
422: $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
423: }
424: }
425: my $percent;
426: if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
427: $percent = 100.0;
428: } else {
429: $percent = 100*($current_disk_usage/$quota);
430: }
431: $current_disk_usage = sprintf("%.0f",$current_disk_usage);
432: $quota = sprintf("%.0f",$quota);
433: $percent = sprintf("%.0f",$percent);
1.5 musolffc 434:
435: # Enter sortable data into hash
436: $usagehash->{ $cid } = {
437: "quotatype" => $quotatype,
438: "cdesc" => $cdesc,
439: "instcode" => $instcode,
440: "quota" => $quota,
441: "current_disk_usage" => $current_disk_usage,
442: "percent" => $percent,
443: };
444: }
445:
446: # Sort courses by $sortby. "cdesc" is the default.
447: my @sorted_courses;
448: if ($sortby =~ m{^(quota|current_disk_usage|percent)$}) {
449: # Numerical fields
450: if ($sortorder eq "rev") {
451: @sorted_courses = sort {
452: $usagehash->{$a}->{$sortby} <=> $usagehash->{$b}->{$sortby}
453: or
454: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
455: } (keys(%{$usagehash}));
456: } else {
457: @sorted_courses = sort {
458: $usagehash->{$b}->{$sortby} <=> $usagehash->{$a}->{$sortby}
459: or
460: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
461: } (keys(%{$usagehash}));
462: }
463: } elsif ($sortby =~ m{^(cdesc|quotatype|instcode)$}) {
464: # String fields
465: if ($sortorder eq "rev") {
466: @sorted_courses = sort {
467: uc($usagehash->{$b}->{$sortby}) cmp uc($usagehash->{$a}->{$sortby})
468: or
469: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
470: } (keys(%{$usagehash}));
471: } else {
472: @sorted_courses = sort {
473: uc($usagehash->{$a}->{$sortby}) cmp uc($usagehash->{$b}->{$sortby})
474: or
475: uc($usagehash->{$a}->{"cdesc"}) cmp uc($usagehash->{$b}->{"cdesc"})
476: } (keys(%{$usagehash}));
477: }
478: }
479:
480: # Print data for each course.
481: foreach my $course (@sorted_courses) {
1.1 raeburn 482: print(&Apache::loncommon::start_data_table_row().
1.5 musolffc 483: '<td>'.$usagehash->{$course}->{"quotatype"}.'</td>'.
1.8 ! raeburn 484: '<td>'.$usagehash->{$course}->{"cdesc"}.'</td>');
! 485: if (($type eq 'official') || (!$type)) {
! 486: print('<td>'.$usagehash->{$course}->{"instcode"}.'</td>');
! 487: }
! 488: print('<td>'.$usagehash->{$course}->{"quota"}.'</td>'.
1.5 musolffc 489: '<td>'.$usagehash->{$course}->{"current_disk_usage"}.'</td>'.
490: '<td>'.$usagehash->{$course}->{"percent"}.'</td>'.
1.1 raeburn 491: &Apache::loncommon::end_data_table_row()
492: );
493: }
494: print(&Apache::loncommon::end_data_table().'<br /><br />');
495: } else {
496: print(&Apache::lonlocal::mt('No courses match search criteria.'));
497: }
498: return;
499: }
500:
501: sub get_filters {
502: my ($dom,$params) = @_;
503: my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
504: 'ownerdomfilter','coursefilter','sincefilter');
505: # created filter
506: my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
507: if ($loncaparev ne 'unknown_cmd') {
508: push(@filterlist,'createdfilter');
509: }
510: my %filter;
511: foreach my $item (@filterlist) {
512: $filter{$item} = '';
513: }
514: if (ref($params) eq 'HASH') {
515: foreach my $item (@filterlist) {
516: $filter{$item} = $params->{$item};
517: }
518: }
519: return (\@filterlist,\%filter);
520: }
521:
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