version 1.925.2.7, 2010/01/06 22:53:58
|
version 1.925.2.9, 2010/01/16 19:56:54
|
Line 10697 sub _add_to_env {
|
Line 10697 sub _add_to_env {
|
} |
} |
} |
} |
|
|
|
sub new_roles_update { |
|
my $rolecount = 0; |
|
foreach my $envkey (keys(%env)) { |
|
next unless ($envkey =~ /^user\.role\./); |
|
$rolecount ++; |
|
} |
|
my $newrolecount = 0; |
|
if (!$rolecount) { |
|
my %userenv; |
|
foreach my $crstype ('official','unofficial','community') { |
|
$userenv{'canrequest.'.$crstype} = |
|
&Apache::lonnet::usertools_access($env{'user.name'}, |
|
$env{'user.domain'},$crstype,'reload','requestcourses'); |
|
} |
|
my $then=$env{'user.login.time'}; |
|
my $refresh=time; |
|
my (%userroles,%allroles,%allgroups,@newroles); |
|
my %roleshash = |
|
&Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active','future','previous'],undef,undef,1); |
|
foreach my $item (keys(%roleshash)) { |
|
my ($uname,$udom,$role,$section) = split(':',$item); |
|
my $where = '/'.$udom.'/'.$uname; |
|
my ($tstart,$tend) = split(':',$roleshash{$item}); |
|
if ($section ne '') { |
|
$where .= '/'.$section; |
|
} |
|
my $spec = $role.'.'.$where; |
|
&Apache::lonnet::set_arearole($role,$where,$tstart,$tend, |
|
$env{'user.domain'},$env{'user.name'}); |
|
$userroles{'user.role.'.$spec} = $tstart.'.'.$tend; |
|
$newrolecount ++; |
|
unless (grep(/^\Q$role\E$/,@newroles)) { |
|
push(@newroles,$role); |
|
} |
|
my $status = |
|
&Apache::lonnet::curr_role_status($tstart,$tend,$refresh,$then); |
|
if ($status eq 'active') { |
|
&Apache::lonnet::gather_roleprivs(\%allroles,\%allgroups,\%userroles, |
|
$where,$role,$tstart,$tend); |
|
} |
|
} |
|
if (@newroles) { |
|
&Apache::lonnet::appenv(\%userroles,[@newroles,'cm']); |
|
my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles, |
|
\%allgroups); |
|
$userenv{'user.adv'} = $adv; |
|
$userenv{'user.author'} = $author; |
|
$userenv{'user.refresh.time'} = $refresh; |
|
} |
|
&Apache::lonnet::appenv(\%userenv); |
|
} |
|
return $newrolecount; |
|
} |
|
|
# --- Get the symbolic name of a problem and the url |
# --- Get the symbolic name of a problem and the url |
sub get_symb { |
sub get_symb { |
my ($request,$silent) = @_; |
my ($request,$silent) = @_; |