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

[raeburn]

raeburn		Wed Jul 25 22:09:25 2007 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Add inst_directory_query() routine for institutional directory searches, by last name, username or lastname, firstname.
  - Add usersearch() routine for search of users in a LON-CAPA domain by querying all library servers in the domain for user information.
  - Add update_allusers_table() to update MySQL allusers table on the user's homeserver when modifying user information.
  - Include id and permanentemail in user information pulled in from environment in &modifyuser().
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.898 loncom/lonnet/perl/lonnet.pm:1.899
--- loncom/lonnet/perl/lonnet.pm:1.898	Fri Jul 20 19:16:19 2007
+++ loncom/lonnet/perl/lonnet.pm	Wed Jul 25 22:09:24 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.898 2007/07/20 23:16:19 albertel Exp $
+# $Id: lonnet.pm,v 1.899 2007/07/26 02:09:24 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -856,6 +856,79 @@
     return;
 }
 
+sub inst_directory_query {
+    my ($srch) = @_;
+    my $udom = $srch->{'srchdomain'};
+    my %results;
+    my $homeserver = &domain($udom,'primary');
+    if ($homeserver ne '') {
+        my $response=&reply("instdirsrch:$udom".':'.
+                            &escape($srch->{'srchby'}).':'.
+                            &escape($srch->{'srchterm'}).':'.
+                            $srch->{'srchtype'},$homeserver);
+        unless ($response eq 'refused') {
+            my @matches = split/&/,$response;
+            foreach my $match (@matches) {
+                my ($key,$value) = split(/=/,$match);
+                my %userhash = &str2hash(&unescape($value));
+                $results{&unescape($key).':'.$udom} = \%userhash;
+            }
+        }
+    }
+    return %results;
+}
+
+sub usersearch {
+    my ($srch) = @_;
+    my $dom = $srch->{'srchdomain'};
+    my %results;
+    my %libserv = &all_library();
+    my $query = 'usersearch';
+    foreach my $tryserver (keys(%libserv)) {
+        if (&host_domain($tryserver) eq $dom) {
+            my $host=&hostname($tryserver);
+            my $queryid=
+                &reply("querysend:".&escape($query).':'.&escape($dom).':'.
+                       &escape($srch->{'srchby'}).'%%'.
+                       &escape($srch->{'srchtype'}).':'.
+                       &escape($srch->{'srchterm'}),$tryserver);
+            if ($queryid !~/^\Q$host\E\_/) {
+                &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);
+                return 'error: '.$queryid;
+            }
+            my $reply = &get_query_reply($queryid);
+            my $maxtries = 1;
+            my $tries = 1;
+            while (($reply=~/^timeout/) && ($tries < $maxtries)) {
+                $reply = &get_query_reply($queryid);
+                $tries ++;
+            }
+            if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
+                &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
+            } else {
+                my @matches = split/&/,$reply;
+                foreach my $match (@matches) {
+                    my @items = split(/:/,$match);
+                    my ($uname,$udom,%userhash);
+                    foreach my $entry (@items) {
+                        my ($key,$value) = split(/=/,$entry);
+                        $key = &unescape($key);
+                        $value = &unescape($value);
+                        $userhash{$key} = $value;
+                        if ($key eq 'username') {
+                            $uname = $value;
+                        } elsif ($key eq 'domain') {
+                            $udom = $value;
+                        } 
+                    }
+                    $results{$uname.':'.$udom} = \%userhash;
+                }
+            }
+        }
+    }
+    return %results;
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -4375,6 +4448,23 @@
     return $reply;
 }
 
+# -------------------------- Update MySQL allusers table
+
+sub update_allusers_table {
+    my ($uname,$udom,$names) = @_;
+    my $homeserver = &homeserver($uname,$udom);
+    my $queryid=
+        &reply('querysend:allusers:'.&escape($uname).':'.&escape($udom).':'.
+               'lastname='.&escape($names->{'lastname'}).'%%'.
+               'firstname='.&escape($names->{'firstname'}).'%%'.
+               'middlename='.&escape($names->{'middlename'}).'%%'.
+               'generation='.&escape($names->{'generation'}).'%%'.
+               'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
+               'id='.&escape($names->{'id'}),$homeserver);
+    my $reply = &get_query_reply($queryid);
+    return $reply;
+}
+
 # ------- Request retrieval of institutional classlists for course(s)
 
 sub fetch_enrollment_query {
@@ -5046,7 +5136,8 @@
     }
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
-		   ['firstname','middlename','lastname','generation'],
+		   ['firstname','middlename','lastname','generation','id',
+                    'permanentemail'],
 		   $udom,$uname);
     my %names;
     if ($tmp[0] =~ m/^error:.*/) { 
@@ -5068,8 +5159,10 @@
 			   $names{'critnotification'} = $email;
 			   $names{'permanentemail'} = $email; }
     }
+    if ($uid) { $names{'id'}  = $uid; }
     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);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.