--- loncom/lonnet/perl/lonnet.pm	2012/09/02 16:23:02	1.1172.2.10
+++ loncom/lonnet/perl/lonnet.pm	2012/05/28 12:28:14	1.1174
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.10 2012/09/02 16:23:02 raeburn Exp $
+# $Id: lonnet.pm,v 1.1174 2012/05/28 12:28:14 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -75,6 +75,8 @@ use LWP::UserAgent();
 use HTTP::Date;
 use Image::Magick;
 
+use Encode;
+
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);
@@ -97,6 +99,7 @@ use File::MMagic;
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;
+use LONCAPA::Lond;
 
 use File::Copy;
 
@@ -108,33 +111,31 @@ require Exporter;
 our @ISA = qw (Exporter);
 our @EXPORT = qw(%env);
 
-# ------------------------------------ Logging (parameters, docs, slots, roles)
+
+# --------------------------------------------------------------------- Logging
 {
     my $logid;
-    sub write_log {
-	my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
-        if ($context eq 'course') {
-            if (($cnum eq '') || ($cdom eq '')) {
-                $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-                $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-            }
+    sub instructor_log {
+	my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
+        if (($cnum eq '') || ($cdom eq '')) {
+            $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         }
 	$logid++;
         my $now = time();
 	my $id=$now.'00000'.$$.'00000'.$logid;
-        my $logentry = {
-                         $id => {
-                                  'exe_uname' => $env{'user.name'},
-                                  'exe_udom'  => $env{'user.domain'},
-                                  'exe_time'  => $now,
-                                  'exe_ip'    => $ENV{'REMOTE_ADDR'},
-                                  'delflag'   => $delflag,
-                                  'logentry'  => $storehash,
-                                  'uname'     => $uname,
-                                  'udom'      => $udom,
-                                }
-                       };
-        return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
+	return &Apache::lonnet::put('nohist_'.$hash_name,
+				    { $id => {
+					'exe_uname' => $env{'user.name'},
+					'exe_udom'  => $env{'user.domain'},
+					'exe_time'  => $now,
+					'exe_ip'    => $ENV{'REMOTE_ADDR'},
+					'delflag'   => $delflag,
+					'logentry'  => $storehash,
+					'uname'     => $uname,
+					'udom'      => $udom,
+				    }
+				  },$cdom,$cnum);
     }
 }
 
@@ -1238,7 +1239,6 @@ sub check_loadbalancing {
     my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect,
         $offloadto,$otherserver);
     my $lonhost = $perlvar{'lonHostID'};
-    my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
     my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
     my $intdom = &Apache::lonnet::internet_dom($lonhost);
@@ -1265,6 +1265,7 @@ sub check_loadbalancing {
         my $currtargets = $result->{'targets'};
         my $currrules = $result->{'rules'};
         if ($currbalancer ne '') {
+            my @hosts = &current_machine_ids();
             if (grep(/^\Q$currbalancer\E$/,@hosts)) {
                 $is_balancer = 1;
             }
@@ -1352,43 +1353,31 @@ sub check_loadbalancing {
             $offloadto = &this_host_spares($dom_in_use);
         }
     }
-    if ($is_balancer) {
-        my $lowest_load = 30000;
-        if (ref($offloadto) eq 'HASH') {
-            if (ref($offloadto->{'primary'}) eq 'ARRAY') {
-                foreach my $try_server (@{$offloadto->{'primary'}}) {
-                    ($otherserver,$lowest_load) =
-                        &compare_server_load($try_server,$otherserver,$lowest_load);
-                }
+    my $lowest_load = 30000;
+    if (ref($offloadto) eq 'HASH') {
+        if (ref($offloadto->{'primary'}) eq 'ARRAY') {
+            foreach my $try_server (@{$offloadto->{'primary'}}) {
+                ($otherserver,$lowest_load) =
+                    &compare_server_load($try_server,$otherserver,$lowest_load);
             }
-            my $found_server = ($otherserver ne '' && $lowest_load < 100);
+        }
+        my $found_server = ($otherserver ne '' && $lowest_load < 100);
 
-            if (!$found_server) {
-                if (ref($offloadto->{'default'}) eq 'ARRAY') {
-                    foreach my $try_server (@{$offloadto->{'default'}}) {
-                        ($otherserver,$lowest_load) =
-                            &compare_server_load($try_server,$otherserver,$lowest_load);
-                    }
-                }
-            }
-        } elsif (ref($offloadto) eq 'ARRAY') {
-            if (@{$offloadto} == 1) {
-                $otherserver = $offloadto->[0];
-            } elsif (@{$offloadto} > 1) {
-                foreach my $try_server (@{$offloadto}) {
+        if (!$found_server) {
+            if (ref($offloadto->{'default'}) eq 'ARRAY') {
+                foreach my $try_server (@{$offloadto->{'default'}}) {
                     ($otherserver,$lowest_load) =
                         &compare_server_load($try_server,$otherserver,$lowest_load);
                 }
             }
         }
-        if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) {
-            $is_balancer = 0;
-            if ($uname ne '' && $udom ne '') {
-                if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
-
-                    &appenv({'user.loadbalexempt'     => $lonhost,
-                             'user.loadbalcheck.time' => time});
-                }
+    } elsif (ref($offloadto) eq 'ARRAY') {
+        if (@{$offloadto} == 1) {
+            $otherserver = $offloadto->[0];
+        } elsif (@{$offloadto} > 1) {
+            foreach my $try_server (@{$offloadto}) {
+                ($otherserver,$lowest_load) =
+                    &compare_server_load($try_server,$otherserver,$lowest_load);
             }
         }
     }
@@ -1398,9 +1387,7 @@ sub check_loadbalancing {
 sub get_loadbalancer_targets {
     my ($rule_in_effect,$currtargets,$uname,$udom) = @_;
     my $offloadto;
-    if ($rule_in_effect eq 'none') {
-        return [$perlvar{'lonHostID'}];
-    } elsif ($rule_in_effect eq '') {
+    if ($rule_in_effect eq '') {
         $offloadto = $currtargets;
     } else {
         if ($rule_in_effect eq 'homeserver') {
@@ -1418,7 +1405,7 @@ sub get_loadbalancer_targets {
                     }
                 }
             } else {
-                my %servers = &internet_dom_servers($udom);
+                my %servers = &dom_servers($udom);
                 my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers);
                 if (&hostname($remotebalancer) ne '') {
                     $offloadto = [$remotebalancer];
@@ -1937,8 +1924,7 @@ sub get_domain_defaults {
     my %domconfig =
          &Apache::lonnet::get_dom('configuration',['defaults','quotas',
                                   'requestcourses','inststatus',
-                                  'coursedefaults','usersessions',
-                                  'requestauthor'],$domain);
+                                  'coursedefaults','usersessions'],$domain);
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1957,7 +1943,7 @@ sub get_domain_defaults {
         } else {
             $domdefaults{'defaultquota'} = $domconfig{'quotas'};
         } 
-        my @usertools = ('aboutme','blog','webdav','portfolio');
+        my @usertools = ('aboutme','blog','portfolio');
         foreach my $item (@usertools) {
             if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
                 $domdefaults{$item} = $domconfig{'quotas'}{$item};
@@ -1969,9 +1955,6 @@ sub get_domain_defaults {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
         }
     }
-    if (ref($domconfig{'requestauthor'}) eq 'HASH') {
-        $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
-    }
     if (ref($domconfig{'inststatus'}) eq 'HASH') {
         foreach my $item ('inststatustypes','inststatusorder') {
             $domdefaults{$item} = $domconfig{'inststatus'}{$item};
@@ -2401,7 +2384,7 @@ sub chatsend {
 
 sub getversion {
     my $fname=&clutter(shift);
-    unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; }
+    unless ($fname=~/^\/res\//) { return -1; }
     return &currentversion(&filelocation('',$fname));
 }
 
@@ -2588,10 +2571,11 @@ sub ssi {
 
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response= $ua->request($request);
+    my $content = Encode::decode_utf8($response->content);
     if (wantarray) {
-	return ($response->content, $response);
+	return ($content, $response);
     } else {
-	return $response->content;
+	return $content;
     }
 }
 
@@ -3529,70 +3513,38 @@ sub userrolelog {
 
 sub courserolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;
-    if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
-        my $cdom = $1;
-        my $cnum = $2;
-        my $sec = $3;
-        my $namespace = 'rolelog';
-        my %storehash = (
-                           role    => $trole,
-                           start   => $tstart,
-                           end     => $tend,
-                           selfenroll => $selfenroll,
-                           context    => $context,
-                        );
-        if ($trole eq 'gr') {
-            $namespace = 'groupslog';
-            $storehash{'group'} = $sec;
-        } else {
-            $storehash{'section'} = $sec;
-        }
-        &write_log('course',$namespace,\%storehash,$delflag,$username,
-                   $domain,$cnum,$cdom);
-        if (($trole ne 'st') || ($sec ne '')) {
-            &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+    if (($trole eq 'cc') || ($trole eq 'in') ||
+        ($trole eq 'ep') || ($trole eq 'ad') ||
+        ($trole eq 'ta') || ($trole eq 'st') ||
+        ($trole=~/^cr/) || ($trole eq 'gr') ||
+        ($trole eq 'co')) {
+        if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
+            my $cdom = $1;
+            my $cnum = $2;
+            my $sec = $3;
+            my $namespace = 'rolelog';
+            my %storehash = (
+                               role    => $trole,
+                               start   => $tstart,
+                               end     => $tend,
+                               selfenroll => $selfenroll,
+                               context    => $context,
+                            );
+            if ($trole eq 'gr') {
+                $namespace = 'groupslog';
+                $storehash{'group'} = $sec;
+            } else {
+                $storehash{'section'} = $sec;
+            }
+            &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+            if (($trole ne 'st') || ($sec ne '')) {
+                &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+            }
         }
     }
     return;
 }
 
-sub domainrolelog {
-    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
-    if ($area =~ m{^/($match_domain)/$}) {
-        my $cdom = $1;
-        my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);
-        my $namespace = 'rolelog';
-        my %storehash = (
-                           role    => $trole,
-                           start   => $tstart,
-                           end     => $tend,
-                           context => $context,
-                        );
-        &write_log('domain',$namespace,\%storehash,$delflag,$username,
-                   $domain,$domconfiguser,$cdom);
-    }
-    return;
-
-}
-
-sub coauthorrolelog {
-    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
-    if ($area =~ m{^/($match_domain)/($match_username)$}) {
-        my $audom = $1;
-        my $auname = $2;
-        my $namespace = 'rolelog';
-        my %storehash = (
-                           role    => $trole,
-                           start   => $tstart,
-                           end     => $tend,
-                           context => $context,
-                        );
-        &write_log('author',$namespace,\%storehash,$delflag,$username,
-                   $domain,$auname,$audom);
-    }
-    return;
-}
-
 sub get_course_adv_roles {
     my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
@@ -3705,7 +3657,7 @@ sub get_my_roles {
         }
         my ($rolecode,$username,$domain,$section,$area);
         if ($context eq 'userroles') {
-            ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/);
+            ($area,$rolecode) = split(/_/,$entry);
             (undef,$domain,$username,$section) = split(/\//,$area);
         } else {
             ($role,$username,$domain,$section) = split(/\:/,$entry);
@@ -5027,19 +4979,15 @@ sub delete_env_groupprivs {
 sub check_adhoc_privs {
     my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
-    my $setprivs;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
         &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
             &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
-            $setprivs = 1;
         }
     } else {
         &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
-        $setprivs = 1;
     }
-    return $setprivs;
 }
 
 sub set_adhoc_privileges {
@@ -5681,15 +5629,10 @@ sub usertools_access {
                       unofficial => 1,
                       community  => 1,
                  );
-    } elsif ($context eq 'requestauthor') {
-        %tools = (
-                      requestauthor => 1,
-                 );
     } else {
         %tools = (
                       aboutme   => 1,
                       blog      => 1,
-                      webdav    => 1,
                       portfolio => 1,
                  );
     }
@@ -5704,32 +5647,25 @@ sub usertools_access {
         if ($action ne 'reload') {
             if ($context eq 'requestcourses') {
                 return $env{'environment.canrequest.'.$tool};
-            } elsif ($context eq 'requestauthor') {
-                return $env{'environment.canrequest.author'};
             } else {
                 return $env{'environment.availabletools.'.$tool};
             }
         }
     }
 
-    my ($toolstatus,$inststatus,$envkey);
-    if ($context eq 'requestauthor') {
-        $envkey = $context;
-    } else {
-        $envkey = $context.'.'.$tool;
-    }
+    my ($toolstatus,$inststatus);
 
     if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
          ($action ne 'reload')) {
-        $toolstatus = $env{'environment.'.$envkey};
+        $toolstatus = $env{'environment.'.$context.'.'.$tool};
         $inststatus = $env{'environment.inststatus'};
     } else {
         if (ref($userenvref) eq 'HASH') {
-            $toolstatus = $userenvref->{$envkey};
+            $toolstatus = $userenvref->{$context.'.'.$tool};
             $inststatus = $userenvref->{'inststatus'};
         } else {
-            my %userenv = &userenvironment($udom,$uname,$envkey,'inststatus');
-            $toolstatus = $userenv{$envkey};
+            my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus');
+            $toolstatus = $userenv{$context.'.'.$tool};
             $inststatus = $userenv{'inststatus'};
         }
     }
@@ -5795,7 +5731,7 @@ sub usertools_access {
             }
         }
     } else {
-        if (($context eq 'tools') && ($tool ne 'webdav')) {
+        if ($context eq 'tools') {
             $access = 1;
         } else {
             $access = 0;
@@ -7516,41 +7452,6 @@ sub assignrole {
                             }
                         }
                     }
-                } elsif ($context eq 'requestauthor') {
-                    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
-                        ($url eq '/'.$udom.'/') && ($role eq 'au')) {
-                        if ($env{'environment.requestauthor'} eq 'automatic') {
-                            $refused = '';
-                        } else {
-                            my %domdefaults = &get_domain_defaults($udom);
-                            if (ref($domdefaults{'requestauthor'}) eq 'HASH') {
-                                my $checkbystatus;
-                                if ($env{'user.adv'}) {
-                                    my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};
-                                    if ($disposition eq 'automatic') {
-                                        $refused = '';
-                                    } elsif ($disposition eq '') {
-                                        $checkbystatus = 1;
-                                    }
-                                } else {
-                                    $checkbystatus = 1;
-                                }
-                                if ($checkbystatus) {
-                                    if ($env{'environment.inststatus'}) {
-                                        my @inststatuses = split(/,/,$env{'environment.inststatus'});
-                                        foreach my $type (@inststatuses) {
-                                            if (($type ne '') &&
-                                                ($domdefaults{'requestauthor'}{$type} eq 'automatic')) {
-                                                $refused = '';
-                                            }
-                                        }
-                                    } elsif ($domdefaults{'requestauthor'}{'default'} eq 'automatic') {
-                                        $refused = '';
-                                    }
-                                }
-                            }
-                        }
-                    }
                 }
                 if ($refused) {
                     &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
@@ -7601,25 +7502,11 @@ sub assignrole {
     if ($answer eq 'ok') {
 	&userrolelog($role,$uname,$udom,$url,$start,$end);
 # for course roles, perform group memberships changes triggered by role change.
+        &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context);
         unless ($role =~ /^gr/) {
             &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
                                              $origstart,$selfenroll,$context);
         }
-        if (($role eq 'cc') || ($role eq 'in') ||
-            ($role eq 'ep') || ($role eq 'ad') ||
-            ($role eq 'ta') || ($role eq 'st') ||
-            ($role=~/^cr/) || ($role eq 'gr') ||
-            ($role eq 'co')) {
-            &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
-                           $selfenroll,$context);
-        } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
-                 ($role eq 'au') || ($role eq 'dc')) {
-            &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
-                           $context);
-        } elsif (($role eq 'ca') || ($role eq 'aa')) {
-            &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
-                             $context);
-        }
         if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);
         }
@@ -9914,41 +9801,6 @@ sub devalidate_slots_cache {
     &devalidate_cache_new('allslots',$hashid);
 }
 
-sub get_coursechange {
-    my ($cdom,$cnum) = @_;
-    if ($cdom eq '' || $cnum eq '') {
-        return unless ($env{'request.course.id'});
-        $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-        $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-    }
-    my $hashid=$cdom.'_'.$cnum;
-    my ($change,$cached)=&is_cached_new('crschange',$hashid);
-    if ((defined($cached)) && ($change ne '')) {
-        return $change;
-    } else {
-        my %crshash;
-        %crshash = &get('environment',['internal.contentchange'],$cdom,$cnum);
-        if ($crshash{'internal.contentchange'} eq '') {
-            $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};
-            if ($change eq '') {
-                %crshash = &get('environment',['internal.created'],$cdom,$cnum);
-                $change = $crshash{'internal.created'};
-            }
-        } else {
-            $change = $crshash{'internal.contentchange'};
-        }
-        my $cachetime = 600;
-        &do_cache_new('crschange',$hashid,$change,$cachetime);
-    }
-    return $change;
-}
-
-sub devalidate_coursechange_cache {
-    my ($cnum,$cdom)=@_;
-    my $hashid=$cnum.':'.$cdom;
-    &devalidate_cache_new('crschange',$hashid);
-}
-
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -10093,11 +9945,7 @@ sub deversion {
 sub symbread {
     my ($thisfn,$donotrecurse)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;
-    if (defined($env{$cache_str})) {
-        if (($thisfn) || ($env{$cache_str} ne '')) {
-            return $env{$cache_str};
-        }
-    }
+    if (defined($env{$cache_str})) { return $env{$cache_str}; }
 # no filename provided? try from environment
     unless ($thisfn) {
         if ($env{'request.symb'}) {