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

[www]

www		Mon Mar 24 13:18:09 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Bug 764: Building reverse lookup database of user roles
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.348 loncom/lonnet/perl/lonnet.pm:1.349
--- loncom/lonnet/perl/lonnet.pm:1.348	Mon Mar 24 09:18:58 2003
+++ loncom/lonnet/perl/lonnet.pm	Mon Mar 24 13:18:09 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.348 2003/03/24 14:18:58 www Exp $
+# $Id: lonnet.pm,v 1.349 2003/03/24 18:18:09 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -74,7 +74,7 @@
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache 
-   %courselogs %accesshash $processmarker $dumpcount 
+   %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache 
    %domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir);
 use IO::Socket;
@@ -1054,6 +1054,17 @@
 	    delete $accesshash{$entry};
         }
     }
+    &logthis('Flushing role logs');
+    foreach (keys %userrolehash) {
+        my $entry=$_;
+        my ($role,$uname,$udom,$runame,$rudom)=
+	    split(/\:/,$entry);
+        if (&Apache::lonnet::put('nohist_userroles',
+                { $role.':'.$uname.':'.$udom => $userrolehash{$entry} },
+                $rudom,$runame) eq 'ok') {
+	    delete $userrolehash{$entry};
+        }
+    }
     $dumpcount++;
 }
 
@@ -1102,7 +1113,17 @@
         $accesshash{$key}=1;
     }
 }
-    
+
+sub userrolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
+    if (($trole=~/^ca/) || ($trole=~/^in/) || 
+        ($trole=~/^cc/) || ($trole=~/^ep/) ||
+        ($trole=~/^cr/)) {
+       my (undef,$rudom,$runame)=split(/\//,$area);
+       $userrolehash{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom}
+                    =$tend.':'.$tstart;
+   }
+}    
 # ----------------------------------------------------------- Check out an item
 
 sub checkout {
@@ -1707,6 +1728,8 @@
             my ($trole,$tend,$tstart)=split(/_/,$role);
             $userroles.='user.role.'.$trole.'.'.$area.'='.
                         $tstart.'.'.$tend."\n";
+# log the associated role with the area
+            &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
             if ($tend!=0) {
 	        if ($tend<$now) {
 	            $trole='';
@@ -2465,7 +2488,11 @@
            $command.='_0_'.$start;
         }
     }
-    return &reply($command,&homeserver($uname,$udom));
+    my $answer=&reply($command,&homeserver($uname,$udom));
+    if ($answer eq 'ok') {
+	&userrolelog($mrole,$uname,$udom,$url,$start,$end);
+    }
+    return $answer;
 }
 
 # -------------------------------------------------- Modify user authentication