--- loncom/lonnet/perl/lonnet.pm 2012/08/17 22:43:58 1.1184 +++ loncom/lonnet/perl/lonnet.pm 2012/08/21 04:04:58 1.1186 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1184 2012/08/17 22:43:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1186 2012/08/21 04:04:58 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3713,7 +3713,7 @@ sub get_my_roles { } my ($rolecode,$username,$domain,$section,$area); if ($context eq 'userroles') { - ($area,$rolecode) = split(/_/,$entry); + ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/); (undef,$domain,$username,$section) = split(/\//,$area); } else { ($role,$username,$domain,$section) = split(/\:/,$entry); @@ -5049,15 +5049,19 @@ sub delete_env_groupprivs { sub check_adhoc_privs { my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; + my $setprivs; if ($env{$cckey}) { my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } } else { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } + return $setprivs; } sub set_adhoc_privileges {