[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Mon, 08 Dec 2008 23:00:48 -0000
raeburn Mon Dec 8 23:00:48 2008 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 5839. Cache information about availability of User Tools (About Me, Portfolio, Blog) for users in a domain.
- Availability determined by user-specific setting in user's environment.db (set by DC) or on domain defaults for user's insitutional affilaition.
- User tools available by default for users from domains on pre-2.8 versions, and domains for which DC has yet to set defaults.
- New routines: &usertools_access() and &is_advanced_user().
- Changes to &get_domain_defaults() so defaults for user tool availability are provided from this routine, and also to support change in storage of quota defaults.
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.975 loncom/lonnet/perl/lonnet.pm:1.976
--- loncom/lonnet/perl/lonnet.pm:1.975 Sat Nov 29 10:34:29 2008
+++ loncom/lonnet/perl/lonnet.pm Mon Dec 8 23:00:47 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.975 2008/11/29 10:34:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.976 2008/12/08 23:00:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1222,12 +1222,12 @@
return (\%ruleshash,\@ruleorder);
}
-# ------------------------- Get Authentication and Language Defaults for Domain
+# ------------- Get Authentication, Language and User Tools Defaults for Domain
sub get_domain_defaults {
my ($domain) = @_;
my $cachetime = 60*60*24;
- my ($defauthtype,$defautharg,$deflang);
+ my ($defauthtype,$defautharg,$deflang,%deftools);
my ($result,$cached)=&is_cached_new('domdefaults',$domain);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
@@ -1236,7 +1236,7 @@
}
my %domdefaults;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['defaults'],$domain);
+ &Apache::lonnet::get_dom('configuration',['defaults','quotas'],$domain);
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1246,6 +1246,19 @@
$domdefaults{'auth_def'} = &domain($domain,'auth_def');
$domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def');
}
+ if (ref($domconfig{'quotas'}) eq 'HASH') {
+ if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
+ $domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'};
+ } else {
+ $domdefaults{'defaultquota'} = $domconfig{'quotas'};
+ }
+ my @usertools = ('aboutme','blog','portfolio');
+ foreach my $item (@usertools) {
+ if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
+ $domdefaults{$item} = $domconfig{'quotas'}{$item};
+ }
+ }
+ }
&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
$cachetime);
return %domdefaults;
@@ -1570,9 +1583,14 @@
sub userenvironment {
my ($udom,$unam,@what)=@_;
+ my $items;
+ foreach my $item (@what) {
+ $items.=&escape($item).'&';
+ }
+ $items=~s/\&$//;
my %returnhash=();
my @answer=split(/\&/,
- &reply('get:'.$udom.':'.$unam.':environment:'.join('&',@what),
+ &reply('get:'.$udom.':'.$unam.':environment:'.$items,
&homeserver($unam,$udom)));
my $i;
for ($i=0;$i<=$#what;$i++) {
@@ -4356,6 +4374,134 @@
return;
}
+sub usertools_access {
+ my ($uname,$udom,$tool) = @_;
+ my $access;
+ my %tools = (
+ aboutme => 1,
+ blog => 1,
+ portfolio => 1,
+ );
+ return if (!defined($tools{$tool}));
+
+ if ((!defined($udom)) || (!defined($uname))) {
+ $udom = $env{'user.domain'};
+ $uname = $env{'user.name'};
+ }
+
+ my $hashid=$uname.':'.$udom;
+ my ($result,$cached) = &is_cached_new('usertools.'.$tool,$hashid);
+ if (defined($cached)) {
+ return $result;
+ }
+
+ my ($toolstatus,$inststatus);
+
+ if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+ $toolstatus = $env{'environment.tools.'.$tool};
+ $inststatus = $env{'environment.inststatus'};
+ } else {
+ my %userenv = &userenvironment($udom,$uname,'tools.'.$tool);
+ $toolstatus = $userenv{'tools.'.$tool};
+ $inststatus = $userenv{'inststatus'};
+ }
+
+ if ($toolstatus ne '') {
+ if ($toolstatus) {
+ $access = 1;
+ } else {
+ $access = 0;
+ }
+ &do_cache_new('usertools.'.$tool,$hashid,$access,600);
+ return $access;
+ }
+
+ my $is_adv = &is_advanced_user($udom,$uname);
+ my %domdef = &get_domain_defaults($udom);
+ if (ref($domdef{$tool}) eq 'HASH') {
+ if ($is_adv) {
+ if ($domdef{$tool}{'_LC_adv'} ne '') {
+ if ($domdef{$tool}{'_LC_adv'}) {
+ $access = 1;
+ } else {
+ $access = 0;
+ }
+ &do_cache_new('usertools.'.$tool,$hashid,$access,600);
+ return $access;
+ }
+ }
+ if ($inststatus ne '') {
+ my ($hasaccess,$hasnoaccess);
+ foreach my $affiliation (split(/:/,$inststatus)) {
+ if ($domdef{$tool}{$affiliation} ne '') {
+ if ($domdef{$tool}{$affiliation}) {
+ $hasaccess = 1;
+ } else {
+ $hasnoaccess = 1;
+ }
+ }
+ }
+ if ($hasaccess || $hasnoaccess) {
+ if ($hasaccess) {
+ $access = 1;
+ } elsif ($hasnoaccess) {
+ $access = 0;
+ }
+ &do_cache_new('usertools.'.$tool,$hashid,$access,600);
+ return $access;
+ }
+ } else {
+ if ($domdef{$tool}{'default'} ne '') {
+ if ($domdef{$tool}{'default'}) {
+ $access = 1;
+ } elsif ($domdef{$tool}{'default'} == 0) {
+ $access = 0;
+ }
+ &do_cache_new('usertools.'.$tool,$hashid,$access,600);
+ return $access;
+ }
+ }
+ } else {
+ $access = 1;
+ &do_cache_new('usertools.'.$tool,$hashid,$access,600);
+ return $access;
+ }
+}
+
+sub is_advanced_user {
+ my ($udom,$uname) = @_;
+ my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
+ my %allroles;
+ my $is_adv;
+ foreach my $role (keys(%roleshash)) {
+ my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
+ my $area = '/'.$tdomain.'/'.$trest;
+ if ($sec ne '') {
+ $area .= '/'.$sec;
+ }
+ if (($area ne '') && ($trole ne '')) {
+ my $spec=$trole.'.'.$area;
+ if ($trole =~ /^cr\//) {
+ &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+ } elsif ($trole ne 'gr') {
+ &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+ }
+ }
+ }
+ foreach my $role (keys(%allroles)) {
+ last if ($is_adv);
+ foreach my $item (split(/:/,$allroles{$role})) {
+ if ($item ne '') {
+ my ($privilege,$restrictions)=split(/&/,$item);
+ if ($privilege eq 'adv') {
+ $is_adv = 1;
+ last;
+ }
+ }
+ }
+ }
+ return $is_adv;
+}
# ---------------------------------------------- Custom access rule evaluation