--- loncom/lonnet/perl/lonnet.pm	2010/10/05 12:53:30	1.1056.2.8
+++ loncom/lonnet/perl/lonnet.pm	2010/05/26 17:14:43	1.1056.4.2
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.2.8 2010/10/05 12:53:30 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.2 2010/05/26 17:14:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3059,7 +3059,7 @@ sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
         $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
-        $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_;
+        $cloneonly,$createdbefore,$createdafter,$creationcontext)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -3081,8 +3081,7 @@ sub courseiddump {
                          $showhidden.':'.$caller.':'.&escape($cloner).':'.
                          &escape($cc_clone).':'.$cloneonly.':'.
                          &escape($createdbefore).':'.&escape($createdafter).':'.
-                         &escape($creationcontext).':'.$domcloner,
-                         $tryserver);
+                         &escape($creationcontext),$tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -4057,7 +4056,7 @@ sub set_userprivs {
                         foreach my $group (keys(%{$$allgroups{$area}})) {
                             my $spec = $trole.'.'.$extendedarea;
                             $grouproles{$spec.'.'.$area.'/'.$group} = 
-                                                  $$allgroups{$area}{$group};
+                                                $$allgroups{$area}{$group};
                         }
                     }
                 }
@@ -4121,6 +4120,7 @@ sub role_status {
                                 my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
                                                     $env{'user.name'});
                                 my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
+
                                 (undef,my $group_privs) = split(/\//,$trole);
                                 $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
@@ -4175,22 +4175,22 @@ sub role_status {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;
+    my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
         &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
-            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+            &set_adhoc_privileges($cdom,$cnum,$checkrole);
         }
     } else {
-        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+        &set_adhoc_privileges($cdom,$cnum,$checkrole);
     }
 }
 
 sub set_adhoc_privileges {
 # role can be cc or ca
-    my ($dcdom,$pickedcourse,$role,$caller) = @_;
+    my ($dcdom,$pickedcourse,$role) = @_;
     my $area = '/'.$dcdom.'/'.$pickedcourse;
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
@@ -4200,16 +4200,14 @@ sub set_adhoc_privileges {
     my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
     &appenv(\%userroles,[$role,'cm']);
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
-    unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
-        &appenv( {'request.role'        => $spec,
-                  'request.role.domain' => $dcdom,
-                  'request.course.sec'  => ''
-                 }
-               );
-        my $tadv=0;
-        if (&allowed('adv') eq 'F') { $tadv=1; }
-        &appenv({'request.role.adv'    => $tadv});
-    }
+    &appenv( {'request.role'        => $spec,
+              'request.role.domain' => $dcdom,
+              'request.course.sec'  => ''
+             }
+           );
+    my $tadv=0;
+    if (&allowed('adv') eq 'F') { $tadv=1; }
+    &appenv({'request.role.adv'    => $tadv});
 }
 
 # --------------------------------------------------------------- get interface
@@ -5665,7 +5663,8 @@ sub update_allusers_table {
                'generation='.&escape($names->{'generation'}).'%%'.
                'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
                'id='.&escape($names->{'id'}),$homeserver);
-    return;
+    my $reply = &get_query_reply($queryid);
+    return $reply;
 }
 
 # ------- Request retrieval of institutional classlists for course(s)
@@ -6582,16 +6581,12 @@ sub modifyuser {
     }
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
+             $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
              ' 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'))) {
@@ -6644,18 +6639,17 @@ sub modifyuser {
 		   ['firstname','middlename','lastname','generation','id',
                     'permanentemail','inststatus'],
 		   $udom,$uname);
-    my (%names,%oldnames);
+    my %names;
     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
 # of users did not contain them), do not overwrite existing values
-# unless field is in $candelete array ref.
+# unless field is in $candelete array ref.  
 #
+
     my @fields = ('firstname','middlename','lastname','generation',
                   'permanentemail','id');
     my %newvalues;
@@ -6668,7 +6662,7 @@ sub modifyuser {
                     $names{$field} = $middle;
                 } elsif ($field eq 'lastname') {
                     $names{$field} = $last;
-                } elsif ($field eq 'generation') {
+                } elsif ($field eq 'generation') { 
                     $names{$field} = $gene;
                 } elsif ($field eq 'permanentemail') {
                     $names{$field} = $email;
@@ -6678,7 +6672,6 @@ sub modifyuser {
             }
         }
     }
-
     if ($first)  { $names{'firstname'}  = $first; }
     if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
@@ -6703,7 +6696,11 @@ sub modifyuser {
             }
         }
     }
-    my $logmsg = $udom.', '.$uname.', '.$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);
+    my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
                  $umode.', '.$first.', '.$middle.', '.
 	         $last.', '.$gene.', '.$email.', '.$inststatus;
     if ($env{'user.name'} ne '' && $env{'user.domain'}) {
@@ -6711,32 +6708,6 @@ sub modifyuser {
     } 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;
-    }
-    if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
-        &Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);
-    }
-    my $sqlresult = &update_allusers_table($uname,$udom,\%names);
-    &devalidate_cache_new('namescache',$uname.':'.$udom);
-    $logmsg = 'Success modifying user '.$logmsg;
     &logthis($logmsg);
     return 'ok';
 }
@@ -9842,6 +9813,12 @@ sub get_dns {
 	return %libserv;
     }
 
+    sub unique_library {
+        #2x reverse removes all hostnames that appear more than once
+        my %unique = reverse &all_library();
+        return reverse %unique;
+    }
+
     sub get_servers {
 	&load_hosts_tab() if (!$loaded);
 
@@ -9865,6 +9842,11 @@ sub get_dns {
 	return %result;
     }
 
+    sub get_unique_servers {
+        my %unique = reverse &get_servers(@_);
+        return reverse %unique;
+    }
+
     sub host_domain {
 	&load_hosts_tab() if (!$loaded);
 
@@ -10433,7 +10415,7 @@ modifyuser($udom,$uname,$uid,$umode,$upa
 will update user information (firstname,middlename,lastname,generation,
 permanentemail), and if forceid is true, student/employee ID also.
 A user's institutional affiliation(s) can also be updated.
-User information fields will not be overwritten with empty entries
+User information fields will not be overwritten with empty entries 
 unless the field is included in the $candelete array reference.
 This array is included when a single user is modified via "Manage Users",
 or when Autoupdate.pl is run by cron in a domain.