--- loncom/lonnet/perl/lonnet.pm	2010/05/22 13:50:19	1.1056.2.4
+++ loncom/lonnet/perl/lonnet.pm	2010/11/11 21:01:38	1.1056.2.10
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.2.4 2010/05/22 13:50:19 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.2.10 2010/11/11 21:01:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1577,7 +1577,8 @@ sub getsection {
     # If there is a role which has expired, return it.
     #
     $courseid = &courseid_to_courseurl($courseid);
-    my %roleshash = &dump('roles',$udom,$unam,$courseid);
+    my $extra = &freeze_escape({'skipcheck' => 1});
+    my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra);
     foreach my $key (keys(%roleshash)) {
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;
@@ -2194,7 +2195,7 @@ sub resizeImage {
 
 # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}
-#                    the desired filenam is in $env{"form.$formname.filename"}
+#                    the desired filename is in $env{"form.$formname.filename"}
 #        $coursedoc - if true up to the current course
 #                     if false
 #        $subdir - directory in userfile to store the file into
@@ -2253,7 +2254,7 @@ sub userfileupload {
     }
     if ($subdir eq 'scantron') {
         $fname = 'scantron_orig_'.$fname;
-    } else {   
+    } else {
 # Create the directory if not present
         $fname="$subdir/$fname";
     }
@@ -2879,8 +2880,9 @@ sub get_my_roles {
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my (%dumphash,%nothide);
-    if ($context eq 'userroles') { 
-        %dumphash = &dump('roles',$udom,$uname);
+    if ($context eq 'userroles') {
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
@@ -3059,7 +3061,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)=@_;
+        $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -3081,7 +3083,8 @@ sub courseiddump {
                          $showhidden.':'.$caller.':'.&escape($cloner).':'.
                          &escape($cc_clone).':'.$cloneonly.':'.
                          &escape($createdbefore).':'.&escape($createdafter).':'.
-                         &escape($creationcontext),$tryserver);
+                         &escape($creationcontext).':'.$domcloner,
+                         $tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -4174,22 +4177,22 @@ sub role_status {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
+    my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;
     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);
+            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
         }
     } else {
-        &set_adhoc_privileges($cdom,$cnum,$checkrole);
+        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
     }
 }
 
 sub set_adhoc_privileges {
 # role can be cc or ca
-    my ($dcdom,$pickedcourse,$role) = @_;
+    my ($dcdom,$pickedcourse,$role,$caller) = @_;
     my $area = '/'.$dcdom.'/'.$pickedcourse;
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
@@ -4199,14 +4202,16 @@ 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);
-    &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});
+    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});
+    }
 }
 
 # --------------------------------------------------------------- get interface
@@ -4255,7 +4260,7 @@ sub del {
 # -------------------------------------------------------------- dump interface
 
 sub dump {
-    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+    my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
@@ -4264,7 +4269,7 @@ sub dump {
     } else {
 	$regexp='.';
     }
-    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
+    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
     foreach my $item (@pairs) {
@@ -4940,6 +4945,11 @@ sub is_course_owner {
 
 sub is_advanced_user {
     my ($udom,$uname) = @_;
+    if ($udom ne '' && $uname ne '') {
+        if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+            return $env{'user.adv'};  
+        }
+    }
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
     my %allroles;
     my $is_adv;
@@ -5662,8 +5672,7 @@ sub update_allusers_table {
                '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)
@@ -6226,7 +6235,8 @@ sub get_users_groups {
     } else {  
         $grouplist = '';
         my $courseurl = &courseid_to_courseurl($courseid);
-        my %roleshash = &dump('roles',$udom,$uname,$courseurl);
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra);
         my $access_end = $env{'course.'.$courseid.
                               '.default_enrollment_end_date'};
         my $now = time;
@@ -6586,6 +6596,10 @@ sub modifyuser {
              ' 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'))) {
@@ -6638,11 +6652,12 @@ sub modifyuser {
 		   ['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
@@ -6696,11 +6711,7 @@ sub modifyuser {
             }
         }
     }
-    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;
     if ($env{'user.name'} ne '' && $env{'user.domain'}) {
@@ -6708,6 +6719,32 @@ 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';
 }
@@ -7081,7 +7118,7 @@ sub is_locked {
     my ($file_name, $domain, $user) = @_;
     my @check;
     my $is_locked;
-    push @check, $file_name;
+    push(@check,$file_name);
     my %locked = &get('file_permissions',\@check,
 		      $env{'user.domain'},$env{'user.name'});
     my ($tmp)=keys(%locked);
@@ -7098,6 +7135,7 @@ sub is_locked {
     } else {
         $is_locked = 'false';
     }
+    return $is_locked;
 }
 
 sub declutter_portfile {