[LON-CAPA-cvs] cvs: loncom(GCI_3) /interface loncommon.pm

[raeburn]

raeburn		Sat Jan 16 15:57:51 2010 EDT

  Modified files:              (Branch: GCI_3)
    /loncom/interface	loncommon.pm 
  Log:
  - Customization for GCI_3.
     - New routine: &new_roles_update() will check %env for existing roles and if
       none, checks for new roles added since login.
     - Adds new roles (and privs) and user.adn, user.author, canrequest.* in %env.   
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.925.2.7 loncom/interface/loncommon.pm:1.925.2.8
--- loncom/interface/loncommon.pm:1.925.2.7	Wed Jan  6 22:53:58 2010
+++ loncom/interface/loncommon.pm	Sat Jan 16 15:57:51 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.925.2.7 2010/01/06 22:53:58 raeburn Exp $
+# $Id: loncommon.pm,v 1.925.2.8 2010/01/16 15:57:51 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -10697,6 +10697,58 @@
     }
 }
 
+sub new_roles_update {
+    my $rolecount = 0;
+    foreach my $envkey (keys(%env)) {
+        next unless ($envkey =~ /^user\.role\./);
+        $rolecount ++;
+    }
+    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;
+            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;
+}
+
 # --- Get the symbolic name of a problem and the url
 sub get_symb {
     my ($request,$silent) = @_;