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

[raeburn]

raeburn		Fri Jul 23 14:59:24 2010 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Bug 5596.
   - Speed-up by not waiting to receive query reply on "querysend" to 
     allusers MySQL table on user's homeserver. This is a write to 
     the table, but a read, so we do not need the query result.
     (Reduces processing time by 2s/student).
  
   - Other efficiency: don't do &put to user's environment.db or update
     allusers table if user information didn't change (unless a new user).
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1074 loncom/lonnet/perl/lonnet.pm:1.1075
--- loncom/lonnet/perl/lonnet.pm:1.1074	Tue Jul 20 02:42:47 2010
+++ loncom/lonnet/perl/lonnet.pm	Fri Jul 23 14:59:24 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1074 2010/07/20 02:42:47 raeburn Exp $
+# $Id: lonnet.pm,v 1.1075 2010/07/23 14:59:24 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5679,8 +5679,7 @@
                'generation='.&escape($names->{'generation'}).'%%'.
                'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
                'id='.&escape($names->{'id'}),$homeserver);
-    my $reply = &get_query_reply($queryid);
-    return $reply;
+    return;
 }
 
 # ------- Request retrieval of institutional classlists for course(s)
@@ -6603,6 +6602,10 @@
              ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
              ' in domain '.$env{'request.role.domain'});
     my $uhome=&homeserver($uname,$udom,'true');
+    my $newuser;
+    if ($uhome eq 'no_host') {
+        $newuser = 1;
+    }
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && 
 	(($umode && $upass) || ($umode eq 'localauth'))) {
@@ -6655,11 +6658,12 @@
 		   ['firstname','middlename','lastname','generation','id',
                     'permanentemail','inststatus'],
 		   $udom,$uname);
-    my %names;
+    my (%names,%oldnames);
     if ($tmp[0] =~ m/^error:.*/) { 
         %names=(); 
     } else {
         %names = @tmp;
+        %oldnames = %names;
     }
 #
 # If name, email and/or uid are blank (e.g., because an uploaded file
@@ -6713,18 +6717,37 @@
             }
         }
     }
-    my $reply = &put('environment', \%names, $udom,$uname);
-    if ($reply ne 'ok') { return 'error: '.$reply; }
-    my $sqlresult = &update_allusers_table($uname,$udom,\%names);
-    &devalidate_cache_new('namescache',$uname.':'.$udom);
-    my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
+    my $logmsg = $udom.', '.$uname.', '.$uid.', '.
                  $umode.', '.$first.', '.$middle.', '.
-	         $last.', '.$gene.', '.$email.', '.$inststatus;
+                 $last.', '.$gene.', '.$email.', '.$inststatus;
     if ($env{'user.name'} ne '' && $env{'user.domain'}) {
         $logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};
     } else {
         $logmsg .= ' during self creation';
     }
+    my $changed;
+    if ($newuser) {
+        $changed = 1;
+    } else {
+        foreach my $field (@fields) {
+            if ($names{$field} ne $oldnames{$field}) {
+                $changed = 1;
+                last;
+            }
+        }
+    }
+    unless ($changed) {
+        $logmsg = 'No changes in user information needed for: '.$logmsg;
+        &logthis($logmsg);
+        return 'ok';
+    }
+    my $reply = &put('environment', \%names, $udom,$uname);
+    if ($reply ne 'ok') { 
+        return 'error: '.$reply;
+    }
+    my $sqlresult = &update_allusers_table($uname,$udom,\%names);
+    &devalidate_cache_new('namescache',$uname.':'.$udom);
+    $logmsg = 'Success modifying user '.$logmsg;
     &logthis($logmsg);
     return 'ok';
 }