--- loncom/lonnet/perl/lonnet.pm	2006/02/09 23:22:59	1.683.2.16
+++ loncom/lonnet/perl/lonnet.pm	2006/01/10 16:06:07	1.692
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.683.2.16 2006/02/09 23:22:59 albertel Exp $
+# $Id: lonnet.pm,v 1.692 2006/01/10 16:06:07 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -289,14 +289,14 @@ sub transfer_profile_to_env {
 
 sub appenv {
     my %newenv=@_;
-    foreach (keys %newenv) {
-	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
+    foreach my $key (keys(%newenv)) {
+	if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) {
             &logthis("<font color=\"blue\">WARNING: ".
-                "Attempt to modify environment ".$_." to ".$newenv{$_}
+                "Attempt to modify environment ".$key." to ".$newenv{$key}
                 .'</font>');
-	    delete($newenv{$_});
+	    delete($newenv{$key});
         } else {
-            $env{$_}=$newenv{$_};
+            $env{$key}=$newenv{$key};
         }
     }
 
@@ -380,12 +380,12 @@ sub delenv {
 	    close($fh);
 	    return 'error: '.$!;
 	}
-	foreach (@oldenv) {
-	    if ($_=~/^$delthis/) { 
-                my ($key,undef) = split('=',$_,2);
+	foreach my $cur_key (@oldenv) {
+	    if ($cur_key=~/^$delthis/) { 
+                my ($key,undef) = split('=',$cur_key,2);
                 delete($env{$key});
             } else {
-                print $fh $_; 
+                print $fh $cur_key; 
             }
 	}
 	close($fh);
@@ -947,50 +947,13 @@ sub userenvironment {
 sub studentphoto {
     my ($udom,$unam,$ext) = @_;
     my $home=&Apache::lonnet::homeserver($unam,$udom);
-    if (defined($env{'request.course.id'})) {
-        if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
-            if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
-                return(&retrievestudentphoto($udom,$unam,$ext)); 
-            } else {
-                my ($result,$perm_reqd)=
-		    &Apache::lonnet::auto_photo_permission($unam,$udom);
-                if ($result eq 'ok') {
-                    if (!($perm_reqd eq 'yes')) {
-                        return(&retrievestudentphoto($udom,$unam,$ext));
-                    }
-                }
-            }
-        }
-    } else {
-        my ($result,$perm_reqd) = 
-	    &Apache::lonnet::auto_photo_permission($unam,$udom);
-        if ($result eq 'ok') {
-            if (!($perm_reqd eq 'yes')) {
-                return(&retrievestudentphoto($udom,$unam,$ext));
-            }
-        }
-    }
-    return '/adm/lonKaputt/lonlogo_broken.gif';
-}
-
-sub retrievestudentphoto {
-    my ($udom,$unam,$ext,$type) = @_;
-    my $home=&Apache::lonnet::homeserver($unam,$udom);
-    my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext:$type",$home);
-    if ($ret eq 'ok') {
-        my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";
-        if ($type eq 'thumbnail') {
-            $url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext"; 
-        }
-        my $tokenurl=&Apache::lonnet::tokenwrapper($url);
-        return $tokenurl;
-    } else {
-        if ($type eq 'thumbnail') {
-            return '/adm/lonKaputt/genericstudent_tn.gif';
-        } else { 
-            return '/adm/lonKaputt/lonlogo_broken.gif';
-        }
+    my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext",$home);
+    my $url="/uploaded/$udom/$unam/internal/studentphoto.".$ext;
+    if ($ret ne 'ok') {
+	return '/adm/lonKaputt/lonlogo_broken.gif';
     }
+    my $tokenurl=&Apache::lonnet::tokenwrapper($url);
+    return $tokenurl;
 }
 
 # -------------------------------------------------------------------- New chat
@@ -1317,8 +1280,15 @@ sub clean_filename {
 }
 
 # --------------- Take an uploaded file and put it into the userfiles directory
-# input: name of form element, coursedoc=1 means this is for the course
-# output: url of file in userspace
+# input: $formname - the contents of the file are in $env{"form.$formname"}
+#                    the desired filenam is in $env{"form.$formname"}
+#        $coursedoc - if true up to the current course
+#                     if false
+#        $subdir - directory in userfile to store the file into
+#        $parser, $allfiles, $codebase - unknown
+#
+# output: url of file in userspace, or error: <message> 
+#             or /adm/notfound.html if failure to upload occurse
 
 
 sub userfileupload {
@@ -3103,7 +3073,6 @@ sub customaccess {
 
 sub allowed {
     my ($priv,$uri,$symb)=@_;
-    my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
     $uri=&declutter($uri);
@@ -3204,7 +3173,7 @@ sub allowed {
                 $thisallowed.=$1;
             }
         } else {
-            my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri};
+            my $refuri=$env{'httpref.'.$orguri};
             if ($refuri) {
                 if ($refuri =~ m|^/adm/|) {
                     $thisallowed='F';
@@ -3443,8 +3412,7 @@ sub is_on_map {
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
     $pathname=~s|/\Q$filename\E$||;
-    $pathname=~s/^adm\/wrapper\///;
-    $pathname=~s/^adm\/coursedocs\/showdoc\///;
+    $pathname=~s/^adm\/wrapper\///;    
     #Trying to find the conditional for the file
     my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
 	       /\&\Q$filename\E\:([\d\|]+)\&/);
@@ -3717,73 +3685,6 @@ sub auto_create_password {
     return ($authparam,$create_passwd,$authchk);
 }
 
-sub auto_photo_permission {
-    my ($cnum,$cdom,$students) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my ($outcome,$perm_reqd,$conditions) = 
-	split(/:/,&unescape(&reply('autophotopermission:'.$cdom,$homeserver)),3);
-    return ($outcome,$perm_reqd,$conditions);
-}
-
-sub auto_checkphotos {
-    my ($uname,$udom,$pid) = @_;
-    my $homeserver = &homeserver($uname,$udom);
-    my ($result,$resulttype);
-    my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.
-				   &escape($uname).':'.&escape($pid),
-				   $homeserver));
-    if ($outcome) {
-        ($result,$resulttype) = split(/:/,$outcome);
-    } 
-    return ($result,$resulttype);
-}
-
-sub auto_photochoice {
-    my ($cnum,$cdom) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.
-						       &escape($cdom),
-						       $homeserver)));
-    return ($update,$comment);
-}
-
-sub auto_photoupdate {
-    my ($affiliatesref,$dom,$cnum,$photo) = @_;
-    my $homeserver = &homeserver($cnum,$dom);
-    my $host=$hostname{$homeserver};
-    my $cmd = '';
-    my $maxtries = 1;
-    foreach (keys %{$affiliatesref}) {
-        $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
-    }
-    $cmd =~ s/%%$//;
-    $cmd = &escape($cmd);
-    my $query = 'institutionalphotos';
-    my $queryid=&reply("querysend:".$query.':'.$dom.':'.$cnum.':'.$cmd,$homeserver);
-    unless ($queryid=~/^\Q$host\E\_/) {
-        &logthis('institutionalphotos: invalid queryid: '.$queryid.' for host: '.$host.' and homeserver: '.$homeserver.' and course: '.$cnum);
-        return 'error: '.$queryid;
-    }
-    my $reply = &get_query_reply($queryid);
-    my $tries = 1;
-    while (($reply=~/^timeout/) && ($tries < $maxtries)) {
-        $reply = &get_query_reply($queryid);
-        $tries ++;
-    }
-    if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
-        &logthis('institutionalphotos error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' course: '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
-    } else {
-        my @responses = split(/:/,$reply);
-        my $outcome = shift(@responses); 
-        foreach my $item (@responses) {
-            my ($key,$value) = split(/=/,$item);
-            $$photo{$key} = $value;
-        }
-        return $outcome;
-    }
-    return 'error';
-}
-
 sub auto_instcode_format {
     my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
     my $courses = '';
@@ -3835,6 +3736,10 @@ sub modify_group_roles {
     my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);
     my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    if ($result eq 'ok') {
+        &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
+    }
+
     return $result;
 }
 
@@ -4919,6 +4824,7 @@ sub EXT {
     } elsif ($realm eq 'resource') {
 
 	my $section;
+        my @groups = ();
 	if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
@@ -4938,12 +4844,20 @@ sub EXT {
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
+                @groups=&sort_course_groups($env{'request.course.groups'},$courseid); 
+                if (@groups > 0) {
+                    @groups = sort(@groups);
+                }
 	    } else {
 		if (! defined($usection)) {
 		    $section=&getsection($udom,$uname,$courseid);
 		} else {
 		    $section = $usection;
 		}
+                my $grouplist = &get_users_groups($udom,$uname,$courseid);
+                if ($grouplist) {
+                    @groups=&sort_course_groups($grouplist,$courseid);
+                }
 	    }
 
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
@@ -4959,12 +4873,17 @@ sub EXT {
 	    my $userreply=&resdata($uname,$udom,'user',
 				       ($courselevelr,$courselevelm,
 					$courselevel));
-
 	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
+            my $coursereply;
+            if (@groups > 0) {
+                $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
+                                       $mapparm,$spacequalifierrest);
+                if (defined($coursereply)) { return $coursereply; }
+            }
 
-	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
 				     $env{'course.'.$courseid.'.domain'},
 				     'course',
 				     ($seclevelr,$seclevelm,$seclevel,
@@ -5035,15 +4954,36 @@ sub EXT {
 	if ($space eq 'time') {
 	    return time;
         }
-    } elsif ($realm eq 'server') {
-# ----------------------------------------------------------------- system.time
-	if ($space eq 'name') {
-	    return $ENV{'SERVER_NAME'};
-        }
     }
     return '';
 }
 
+sub check_group_parms {
+    my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
+    my @groupitems = ();
+    my $resultitem;
+    my @levels = ($symbparm,$mapparm,$what);
+    foreach my $group (@{$groups}) {
+        foreach my $level (@levels) {
+             my $item = $courseid.'.['.$group.'].'.$level;
+             push(@groupitems,$item);
+        }
+    }
+    my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                            $env{'course.'.$courseid.'.domain'},
+                                     'course',@groupitems);
+    return $coursereply;
+}
+
+sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
+    my ($grouplist,$courseid) = @_;
+    my @groups = split/:/,$grouplist;
+    if (@groups > 1) {
+        @groups = sort(@groups);
+    }
+    return @groups;
+}
+
 sub packages_tab_default {
     my ($uri,$varname)=@_;
     my (undef,$part,$name)=split(/\./,$varname);
@@ -5271,7 +5211,7 @@ sub metadata {
 	$metaentry{':keys'}=join(',',keys %metathesekeys);
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache_new('meta',$uri,\%metaentry,60*60);
+	&do_cache_new('meta',$uri,\%metaentry,60*60*24);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -5367,17 +5307,10 @@ sub get_slot {
 	$cdom=$env{'course.'.$courseid.'.domain'};
 	$cnum=$env{'course.'.$courseid.'.num'};
     }
-    my $key=join("\0",'slots',$cdom,$cnum,$which);
-    my %slotinfo;
-    if (exists($remembered{$key})) {
-	$slotinfo{$which} = $remembered{$key};
-    } else {
-	%slotinfo=&get('slots',[$which],$cdom,$cnum);
-	&Apache::lonhomework::showhash(%slotinfo);
-	my ($tmp)=keys(%slotinfo);
-	if ($tmp=~/^error:/) { return (); }
-	$remembered{$key} = $slotinfo{$which};
-    }
+    my %slotinfo=&get('slots',[$which],$cdom,$cnum);
+    &Apache::lonhomework::showhash(%slotinfo);
+    my ($tmp)=keys(%slotinfo);
+    if ($tmp=~/^error:/) { return (); }
     if (ref($slotinfo{$which}) eq 'HASH') {
 	return %{$slotinfo{$which}};
     }
@@ -5411,7 +5344,6 @@ sub symbverify {
     my $thisfn=$thisurl;
 # wrapper not part of symbs
     $thisfn=~s/^\/adm\/wrapper//;
-    $thisfn=~s/^\/adm\/coursedocs\/showdoc\///;
     $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }
@@ -5466,7 +5398,6 @@ sub symbclean {
 # remove wrapper
 
     $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
-    $symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/;
     return $symb;
 }
 
@@ -6117,11 +6048,6 @@ sub filelocation {
     my ($dir,$file) = @_;
     my $location;
     $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
-
-    if ($file =~ m-^/adm/-) {
-	$file=~s-^/adm/wrapper/-/-;
-	$file=~s-^/adm/coursedocs/showdoc/-/-;
-    }
     if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
@@ -6161,9 +6087,6 @@ sub hreflocation {
     my ($dir,$file)=@_;
     unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
 	$file=filelocation($dir,$file);
-    } elsif ($file=~m-^/adm/-) {
-	$file=~s-^/adm/wrapper/-/-;
-	$file=~s-^/adm/coursedocs/showdoc/-/-;
     }
     if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
 	$file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
@@ -6207,8 +6130,6 @@ sub declutter {
     if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
     $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
     $thisfn=~s/^\///;
-    $thisfn=~s|^adm/wrapper/||;
-    $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
     $thisfn=~s/\?.+$//;
     return $thisfn;
@@ -6221,30 +6142,6 @@ sub clutter {
     unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn; 
     }
-    if ($thisfn !~m|/adm|) {
-	if ($thisfn =~ m|/ext/|) {
-	    $thisfn='/adm/wrapper'.$thisfn;
-	} else {
-	    my ($ext) = ($thisfn =~ /\.(\w+)$/);
-	    my $embstyle=&Apache::loncommon::fileembstyle($ext);
-	    if ($embstyle eq 'ssi'
-		|| ($embstyle eq 'hdn')
-		|| ($embstyle eq 'rat')
-		|| ($embstyle eq 'prv')
-		|| ($embstyle eq 'ign')) {
-		#do nothing with these
-	    } elsif (($embstyle eq 'img') 
-		|| ($embstyle eq 'emb')
-		|| ($embstyle eq 'wrp')) {
-		$thisfn='/adm/wrapper'.$thisfn;
-	    } elsif ($embstyle eq 'unk'
-		     && $thisfn!~/\.(sequence|page)$/) {
-		$thisfn='/adm/coursedocs/showdoc'.$thisfn;
-	    } else {
-		#&logthis("Got a blank emb style");
-	    }
-	}
-    }
     return $thisfn;
 }
 
@@ -6388,7 +6285,7 @@ BEGIN {
     }
     close($config);
     # FIXME: dev server don't want this, production servers _do_ want this
-    &get_iphost();
+    #&get_iphost();
 }
 
 sub get_iphost {