--- loncom/interface/loncommon.pm 2013/06/05 13:28:22 1.1075.2.40 +++ loncom/interface/loncommon.pm 2013/07/05 19:53:11 1.1075.2.41 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.40 2013/06/05 13:28:22 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.41 2013/07/05 19:53:11 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -8548,11 +8548,14 @@ sub get_user_info { =item * &get_user_quota() -Retrieves quota assigned for storage of portfolio files for a user +Retrieves quota assigned for storage of user files. +Default is to report quota for portfolio files. Incoming parameters: 1. user's username 2. user's domain +3. quota name - portfolio, author, or course + (if no quota name provided, defaults to portfolio). Returns: 1. Disk quota (in Mb) assigned to student. @@ -8566,7 +8569,7 @@ Returns: If a value has been stored in the user's environment, it will return that, otherwise it returns the maximal default -defined for the user's instituional status(es) in the domain. +defined for the user's institutional status(es) in the domain. =cut @@ -8574,7 +8577,7 @@ defined for the user's instituional stat sub get_user_quota { - my ($uname,$udom) = @_; + my ($uname,$udom,$quotaname) = @_; my ($quota,$quotatype,$settingstatus,$defquota); if (!defined($udom)) { $udom = $env{'user.domain'}; @@ -8589,27 +8592,52 @@ sub get_user_quota { $defquota = 0; } else { my $inststatus; - if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) { - $quota = $env{'environment.portfolioquota'}; - $inststatus = $env{'environment.inststatus'}; + if ($quotaname eq 'course') { + if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) && + ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) { + $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'}; + } else { + my %cenv = &Apache::lonnet::coursedescription("$udom/$uname"); + $quota = $cenv{'internal.uploadquota'}; + } } else { - my %userenv = - &Apache::lonnet::get('environment',['portfolioquota', - 'inststatus'],$udom,$uname); - my ($tmp) = keys(%userenv); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $quota = $userenv{'portfolioquota'}; - $inststatus = $userenv{'inststatus'}; + if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) { + if ($quotaname eq 'author') { + $quota = $env{'environment.authorquota'}; + } else { + $quota = $env{'environment.portfolioquota'}; + } + $inststatus = $env{'environment.inststatus'}; } else { - undef(%userenv); + my %userenv = + &Apache::lonnet::get('environment',['portfolioquota', + 'authorquota','inststatus'],$udom,$uname); + my ($tmp) = keys(%userenv); + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { + if ($quotaname eq 'author') { + $quota = $userenv{'authorquota'}; + } else { + $quota = $userenv{'portfolioquota'}; + } + $inststatus = $userenv{'inststatus'}; + } else { + undef(%userenv); + } } } - ($defquota,$settingstatus) = &default_quota($udom,$inststatus); - if ($quota eq '') { - $quota = $defquota; - $quotatype = 'default'; - } else { - $quotatype = 'custom'; + if ($quota eq '' || wantarray) { + if ($quotaname eq 'course') { + my %domdefs = &Apache::lonnet::get_domain_defaults($udom); + $defquota = $domdefs{'uploadquota'}; + } else { + ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname); + } + if ($quota eq '') { + $quota = $defquota; + $quotatype = 'default'; + } else { + $quotatype = 'custom'; + } } } if (wantarray) { @@ -8634,7 +8662,9 @@ Incoming parameters: status types (e.g., faculty, staff, student etc.) which apply to the user for whom the default is being retrieved. If the institutional status string in undefined, the domain - default quota will be returned. + default quota will be returned. +3. quota name - portfolio, author, or course + (if no quota name provided, defaults to portfolio). Returns: 1. Default disk quota (in Mb) for user portfolios in the domain. @@ -8658,25 +8688,29 @@ default quota returned. sub default_quota { - my ($udom,$inststatus) = @_; + my ($udom,$inststatus,$quotaname) = @_; my ($defquota,$settingstatus); my %quotahash = &Apache::lonnet::get_dom('configuration', ['quotas'],$udom); + my $key = 'defaultquota'; + if ($quotaname eq 'author') { + $key = 'authorquota'; + } if (ref($quotahash{'quotas'}) eq 'HASH') { if ($inststatus ne '') { my @statuses = map { &unescape($_); } split(/:/,$inststatus); foreach my $item (@statuses) { - if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') { - if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') { + if (ref($quotahash{'quotas'}{$key}) eq 'HASH') { + if ($quotahash{'quotas'}{$key}{$item} ne '') { if ($defquota eq '') { - $defquota = $quotahash{'quotas'}{'defaultquota'}{$item}; + $defquota = $quotahash{'quotas'}{$key}{$item}; $settingstatus = $item; - } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) { - $defquota = $quotahash{'quotas'}{'defaultquota'}{$item}; + } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) { + $defquota = $quotahash{'quotas'}{$key}{$item}; $settingstatus = $item; } } - } else { + } elsif ($key eq 'defaultquota') { if ($quotahash{'quotas'}{$item} ne '') { if ($defquota eq '') { $defquota = $quotahash{'quotas'}{$item}; @@ -8690,16 +8724,20 @@ sub default_quota { } } if ($defquota eq '') { - if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') { - $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'}; - } else { + if (ref($quotahash{'quotas'}{$key}) eq 'HASH') { + $defquota = $quotahash{'quotas'}{$key}{'default'}; + } elsif ($key eq 'defaultquota') { $defquota = $quotahash{'quotas'}{'default'}; } $settingstatus = 'default'; } } else { $settingstatus = 'default'; - $defquota = 20; + if ($quotaname eq 'author') { + $defquota = 500; + } else { + $defquota = 20; + } } if (wantarray) { return ($defquota,$settingstatus); @@ -8708,6 +8746,47 @@ sub default_quota { } } +############################################### + +=pod + +=item * &excess_filesize_authorspace() + +Returns warning message if upload of file to authoring space, or copying +of existing file within authoring space will cause quota to be exceeded. + +Inputs: 6 +1. username +2. domain +3. directory path for top level of current authoring space +4. filename of file for which action is being requested +5. filesize (kB) of file +6. action being taken: copy or upload. + +Returns: 1 scalar: HTML to display containing warning if quota would be exceeded, + otherwise return null. + +=cut + +sub excess_filesize_authorspace { + my ($uname,$udom,$authorspace,$filename,$filesize,$action) = @_; + my $disk_quota = &Apache::loncommon::get_user_quota($uname,$udom,'author'); #expressed in MB + $disk_quota = int($disk_quota * 1000); + my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace); + if (($current_disk_usage + $filesize) > $disk_quota) { + return '

'. + &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.", + ''.$filename.'',$filesize).''. + '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', + $disk_quota,$current_disk_usage). + '

'; + } + return; +} + +############################################### + + sub get_secgrprole_info { my ($cdom,$cnum,$needroles,$type) = @_; my %sections_count = &get_sections($cdom,$cnum);