[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Mon Feb 24 03:09:06 2014 EDT

  Modified files:              (Branch: version_2_11_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - For 2.11
    - Backport 1.1250, 1.1251.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1172.2.39 loncom/lonnet/perl/lonnet.pm:1.1172.2.40
--- loncom/lonnet/perl/lonnet.pm:1.1172.2.39	Sun Jan  5 11:45:01 2014
+++ loncom/lonnet/perl/lonnet.pm	Mon Feb 24 03:09:05 2014
@@ -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 @@
 	    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 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 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, at pwhere)=split(/\./,$rolekey);
+        my ($one,$two) = split(m{\./},$rolekey,2);
+        (undef,undef,$$role) = split(/\./,$one,3);
         unless (!defined($$role) || $$role eq '') {
-            $$where=join('.', at pwhere);
+            $$where = '/'.$two;
             $$trolecode=$$role.'.'.$$where;
             ($$tstart,$$tend)=split(/\./,$env{$rolekey});
             $$tstatus='is';