--- loncom/lonnet/perl/lonnet.pm 2010/01/15 00:14:01 1.1048.2.1 +++ loncom/lonnet/perl/lonnet.pm 2010/01/16 15:08:57 1.1048.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1048.2.1 2010/01/15 00:14:01 raeburn Exp $ +# $Id: lonnet.pm,v 1.1048.2.2 2010/01/16 15:08:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4038,13 +4038,6 @@ sub role_status { ); my $spec=$$role.'.'.$$where; my ($tdummy,$tdomain,$trest)=split(/\//,$$where); - if ($$role eq 'gr') { - my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, - $env{'user.name'})=@_; - my ($trole) = split('_',$role,1); - (undef,my $group_privs) = split(/\//,$trole); - $group_privs = &unescape($group_privs); - } if ($$role =~ /^cr\//) { &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where); } elsif ($$role eq 'gr') { @@ -4076,6 +4069,41 @@ sub role_status { } } +sub curr_role_status { + my ($start,$end,$refresh,$then) = @_; + if (($start) && ($start<0)) { return 'deleted' }; + my $status = 'active'; + if (($end) && ($end<=$then)) { + $status = 'previous'; + } + if (($start) && ($refresh<$start)) { + $status = 'future'; + } + return $status; +} + +sub gather_roleprivs { + my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend) = @_; + return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH')); + if (($area ne '') && ($role ne '')) { + my $spec = $role.'.'.$area; + my ($tdummy,$tdomain,$trest)=split(/\//,$area); + if ($role =~ /^cr\//) { + &custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area); + } elsif ($role eq 'gr') { + my %rolehash = &get('roles',[$area.'_'.$role],$env{'user.domain'}, + $env{'user.name'}); + my $trole = split('_',$rolehash{$area.'_'.$role},1); + (undef,my $group_privs) = split(/\//,$trole); + $group_privs = &unescape($group_privs); + &group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart); + } else { + &standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area); + } + } + return; +} + sub check_adhoc_privs { my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;