--- loncom/lonnet/perl/lonnet.pm	2014/01/05 11:45:01	1.1172.2.39
+++ loncom/lonnet/perl/lonnet.pm	2014/02/24 03:09:05	1.1172.2.40
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.39 2014/01/05 11:45:01 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.40 2014/02/24 03:09:05 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -671,7 +671,7 @@ sub appenv {
 	    if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) {
                 $refused = 1;
                 if (ref($roles) eq 'ARRAY') {
-                    my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./);
+                    my ($type,$role) = ($key =~ m{^user\.(role|priv)\.(.+?)\./});
                     if (grep(/^\Q$role\E$/,@{$roles})) {
                         $refused = 0;
                     }
@@ -5291,7 +5291,7 @@ sub set_arearole {
 sub custom_roleprivs {
     my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
-    my $homsvr=homeserver($rauthor,$rdomain);
+    my $homsvr = &homeserver($rauthor,$rdomain);
     if (&hostname($homsvr) ne '') {
         my ($rdummy,$roledef)=
             &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
@@ -5412,11 +5412,11 @@ sub set_userprivs {
 
 sub role_status {
     my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
-    my @pwhere = ();
     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
-        (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
+        my ($one,$two) = split(m{\./},$rolekey,2);
+        (undef,undef,$$role) = split(/\./,$one,3);
         unless (!defined($$role) || $$role eq '') {
-            $$where=join('.',@pwhere);
+            $$where = '/'.$two;
             $$trolecode=$$role.'.'.$$where;
             ($$tstart,$$tend)=split(/\./,$env{$rolekey});
             $$tstatus='is';