Annotation of loncom/cgi/quotacheck.pl, revision 1.4
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.4 ! musolffc 9: # $Id: quotacheck.pl,v 1.3 2014/07/31 15:02:26 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:
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'};
103: }
104: if ($params{'fixeddom'}) {
105: $reqdom = $params{'fixeddom'};
106: }
107: }
108: if (($reqdom eq '') && ($ENV{'QUERY_STRING'})) {
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: }
119: }
120: if ($reqdom eq '') {
121: $reqdom = &Apache::lonnet::default_login_domain();
122: }
123:
124: &Apache::lonlocal::get_language_handle();
125: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 126: ({href=>$script."?domain=$reqdom",
1.1 raeburn 127: text=>"Content disk usage"});
128: if ($params{'gosearch'}) {
129: &Apache::lonhtmlcommon::add_breadcrumb
1.3 musolffc 130: ({href=>$script."?domain=$reqdom",
1.1 raeburn 131: text=>"Result"});
132: }
133: my $domdesc = &Apache::lonnet::domain($reqdom,'description');
1.4 ! musolffc 134: my $starthash = {
! 135: add_entries => {'onload' => "javascript:courseSet(document.filterpicker.official, 'load');"},
! 136: };
! 137: print(&Apache::loncommon::start_page('Course/Community disk usage and quotas', undef, $starthash).
1.1 raeburn 138: &Apache::lonhtmlcommon::breadcrumbs('Course/Community status').
139: '<h2>'.&Apache::lonlocal::mt('Quotas for uploaded course content').'</h2>'.
140: '<h3>'.$domdesc.'</h3>');
141:
142: #
143: # If this is for an authenticated user (i.e., not IP-based access)
144: # create display to choose filters to restrict courses/communities displayed
145: # (e.g., recent activity, recently created, institutional code, course owner etc.)
146: #
147:
148: if (($Apache::lonnet::env{'user.name'}) && ($Apache::lonnet::env{'user.domain'})) {
149: my ($numtitles,@codetitles);
150: print(&Apache::loncommon::js_changer());
151: my ($filterlist,$filter) = &get_filters($reqdom,\%params);
152: $Apache::lonnet::env{'form.official'} = $params{'official'};
153: if ($params{'official'}) {
154: my @standardnames = &Apache::loncommon::get_standard_codeitems();
155: pop(@standardnames);
156: foreach my $item (@standardnames) {
157: if ($params{'official'} eq 'on') {
158: $Apache::lonnet::env{'form.'.$item} = $params{$item};
159: } else {
160: $Apache::lonnet::env{'form.'.$item} = 0;
161: }
162: }
163: $Apache::lonnet::env{'form.state'} = $params{'state'};
164: }
165: print(&Apache::loncommon::build_filters($filterlist,$crstype,undef,undef,$filter,
1.3 musolffc 166: $script,\$numtitles,
1.1 raeburn 167: 'quotacheck',undef,undef,undef,
168: \@codetitles,$reqdom,'quotacheck',$reqdom));
169: if ($params{'gosearch'}) {
170: if ($params{'official'} eq 'on') {
171: $Apache::lonnet::env{'form.state'} = $params{'state'};
172: }
173: my %courses = &Apache::loncommon::search_courses($reqdom,$crstype,$filter,$numtitles,
174: undef,undef,undef,\@codetitles);
175: my @showcourses = keys(%courses);
176: &print_usage($lonhost,$reqdom,\@showcourses);
177: }
178: print(&Apache::loncommon::end_page());
179: return;
180: }
181: &print_usage($lonhost,$reqdom);
182: print(&Apache::loncommon::end_page());
183: return;
184: }
185:
186: sub print_usage {
187: my ($lonhost,$dom,$courses) = @_;
188: my @domains = &Apache::lonnet::current_machine_domains();
189: my @ids=&Apache::lonnet::current_machine_ids();
190: my $domain = &Apache::lonnet::host_domain($lonhost);
191:
192: #
193: # If user's current role is domain coordinator, domain of courses/communities
194: # to be shown needs to be domain being coordinated.
195: #
196: if ($Apache::lonnet::env{'request.role'} =~ m{^dc\./}) {
197: $domain = $Apache::lonnet::env{'request.role.domain'};
198: unless ($dom eq $domain) {
199: my $otherdomdesc = &Apache::lonnet::domain($domain,'description');
200: print('<p class="LC_error">'.
201: &Apache::lonlocal::mt('Requested domain does not match domain being coordinated.').
202: '</p>'."\n".
203: '<p class="LC_info">'.
204: &Apache::lonlocal::mt('Show quotas for the domain being coordinated: [_1]',
1.3 musolffc 205: '<a href="'.$script.'?domain='.$domain.'">'.
1.1 raeburn 206: $otherdomdesc.'</a>').
207: '</p>');
208: return;
209: }
210: } else {
211: unless (grep(/^\Q$dom\E/,@domains)) {
212: print('<p class="LC_error">'.
213: &Apache::lonlocal::mt('Requested domain is not hosted on this server.').
214: '</p>');
215: return;
216: }
217: }
218: my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
219: my @showcourses;
220: if (ref($courses) eq 'ARRAY') {
221: @showcourses = @{$courses};
222: } else {
223: my %courseshash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',undef,undef,'.');
224: if (keys(%courseshash)) {
225: @showcourses = keys(%courseshash);
226: }
227: }
228: if (@showcourses) {
229: print(&Apache::loncommon::start_data_table().
230: &Apache::loncommon::start_data_table_header_row().
231: '<th>'.&Apache::lonlocal::mt('Course Type').'</th>'.
232: '<th>'.&Apache::lonlocal::mt('Course Title').'</th>'.
233: '<th>'.&Apache::lonlocal::mt('Institutional Code').'</th>'.
234: '<th>'.&Apache::lonlocal::mt('Quota (MB)').'</th>'.
235: '<th>'.&Apache::lonlocal::mt('Usage (MB)').'</th>'.
236: '<th>'.&Apache::lonlocal::mt('Percent usage').'</th>'.
237: &Apache::loncommon::end_data_table_header_row());
238: foreach my $cid (@showcourses) {
239: my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
240: my $cdesc = $courseinfo{'description'};
241: my $cnum = $courseinfo{'num'};
242: my $chome = $courseinfo{'home'};
243: my $crstype = $courseinfo{'type'};
244: if ($crstype eq '') {
245: if ($cnum =~ /^$LONCAPA::match_community$/) {
246: $crstype = 'Community';
247: } else {
248: $crstype = 'Course';
249: }
250: }
251: my $instcode = $courseinfo{'internal.coursecode'};
252: my $quota = $courseinfo{'internal.uploadquota'};
253: $quota =~ s/[^\d\.]+//g;
254: my $quotatype = 'unofficial';
255: if ($crstype eq 'Community') {
256: $quotatype = 'community';
257: } elsif ($courseinfo{'internal.coursecode'}) {
258: $quotatype = 'official';
259: } elsif ($courseinfo{'internal.textbook'}) {
260: $quotatype = 'textbook';
261: }
262: if ($quota eq '') {
263: $quota = $domdefs{$crstype.'quota'};
264: }
265: $quota =~ s/[^\d\.]+//g;
266: if ($quota eq '') {
267: $quota = 500;
268: }
269: my $current_disk_usage = 0;
270: if (grep(/^\Q$chome\E$/,@ids)) {
271: my $dir = &propath($dom,$cnum).'/userfiles/';
272: foreach my $subdir ('docs','supplemental') {
273: my $ududir = "$dir/$subdir";
274: my $total_size=0;
275: my $code=sub {
276: if (-d $_) { return;}
277: $total_size+=(stat($_))[7];
278: };
279: chdir($ududir);
280: find($code,$ududir);
281: $total_size=int($total_size/(1024*1024));
282: $current_disk_usage += $total_size;
283: }
284: } else {
285: foreach my $subdir ('docs','supplemental') {
286: $current_disk_usage += &Apache::lonnet::diskusage($dom,$cnum,"userfiles/$subdir",1);
287: }
1.2 raeburn 288: $current_disk_usage=int($current_disk_usage/1024);
1.1 raeburn 289: }
290: my $percent;
291: if (($quota == 0) || ($quota =~ /[^\d\.]/)) {
292: $percent = 100.0;
293: } else {
294: $percent = 100*($current_disk_usage/$quota);
295: }
296: $current_disk_usage = sprintf("%.0f",$current_disk_usage);
297: $quota = sprintf("%.0f",$quota);
298: $percent = sprintf("%.0f",$percent);
299: print(&Apache::loncommon::start_data_table_row().
300: '<td>'.$quotatype.'</td>'.
301: '<td>'.$cdesc.'</td>'.
302: '<td>'.$instcode.'</td>'.
303: '<td>'.$quota.'</td>'.
304: '<td>'.$current_disk_usage.'</td>'.
305: '<td>'.$percent.'</td>'.
306: &Apache::loncommon::end_data_table_row()
307: );
308: }
309: print(&Apache::loncommon::end_data_table().'<br /><br />');
310: } else {
311: print(&Apache::lonlocal::mt('No courses match search criteria.'));
312: }
313: return;
314: }
315:
316: sub get_filters {
317: my ($dom,$params) = @_;
318: my @filterlist = ('descriptfilter','instcodefilter','ownerfilter',
319: 'ownerdomfilter','coursefilter','sincefilter');
320: # created filter
321: my $loncaparev = &Apache::lonnet::get_server_loncaparev($dom);
322: if ($loncaparev ne 'unknown_cmd') {
323: push(@filterlist,'createdfilter');
324: }
325: my %filter;
326: foreach my $item (@filterlist) {
327: $filter{$item} = '';
328: }
329: if (ref($params) eq 'HASH') {
330: foreach my $item (@filterlist) {
331: $filter{$item} = $params->{$item};
332: }
333: }
334: return (\@filterlist,\%filter);
335: }
336:
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