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

[raeburn]

raeburn		Sat Jan 16 15:08:58 2010 EDT

  Modified files:              (Branch: GCI_3)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Backport 1.1049.
  - Add two routines: &gather_roleprivs() and &curr_role_status() to allow
    update of role privileges for new active roles without logout/re-login.  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1048.2.1 loncom/lonnet/perl/lonnet.pm:1.1048.2.2
--- loncom/lonnet/perl/lonnet.pm:1.1048.2.1	Fri Jan 15 00:14:01 2010
+++ loncom/lonnet/perl/lonnet.pm	Sat Jan 16 15:08:57 2010
@@ -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 @@
                             );
                             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 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;