--- loncom/lonnet/perl/lonnet.pm	2005/03/17 21:02:00	1.611
+++ loncom/lonnet/perl/lonnet.pm	2005/04/05 20:43:27	1.619
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.611 2005/03/17 21:02:00 albertel Exp $
+# $Id: lonnet.pm,v 1.619 2005/04/05 20:43:27 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,7 +40,8 @@ qw(%perlvar %hostname %badServerCache %i
    %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
+   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
+   %env);
 
 use IO::Socket;
 use GDBM_File;
@@ -54,6 +55,11 @@ use Cache::Memcached;
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
+require Exporter;
+
+our @ISA = qw (Exporter);
+our @EXPORT = qw(%env);
+
 =pod
 
 =head1 Package Variables
@@ -279,6 +285,7 @@ sub transfer_profile_to_env {
 	chomp($profile[$envi]);
 	my ($envname,$envvalue)=split(/=/,$profile[$envi]);
 	$ENV{$envname} = $envvalue;
+	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
                 $Remove{$key}++;
@@ -286,6 +293,7 @@ sub transfer_profile_to_env {
         }
     }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";
+    $env{'user.environment'} = "$lonidsdir/$handle.id";
     foreach my $expired_key (keys(%Remove)) {
         &delenv($expired_key);
     }
@@ -303,6 +311,7 @@ sub appenv {
 	    delete($newenv{$_});
         } else {
             $ENV{$_}=$newenv{$_};
+            $env{$_}=$newenv{$_};
         }
     }
 
@@ -390,6 +399,7 @@ sub delenv {
 	    if ($_=~/^$delthis/) { 
                 my ($key,undef) = split('=',$_);
                 delete($ENV{$key});
+                delete($env{$key});
             } else {
                 print $fh $_; 
             }
@@ -931,6 +941,19 @@ sub userenvironment {
     return %returnhash;
 }
 
+# ---------------------------------------------------------- Get a studentphoto
+sub studentphoto {
+    my ($udom,$unam,$ext) = @_;
+    my $home=&Apache::lonnet::homeserver($unam,$udom);
+    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
 
 sub chatsend {
@@ -1293,7 +1316,6 @@ sub finishuserfileupload {
     }
 # Notify homeserver to grep it
 #
-    &Apache::lonnet::logthis("fetching ".$path.$file);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
 #
@@ -1309,7 +1331,7 @@ sub finishuserfileupload {
 sub removeuploadedurl {
     my ($url)=@_;
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
-    return &Apache::lonnet::removeuserfile($uname,$udom,$fname);
+    return &removeuserfile($uname,$udom,$fname);
 }
 
 sub removeuserfile {
@@ -2778,7 +2800,7 @@ sub allowed {
 # URI is an uploaded document for this course
 # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
-	my $refuri=$ENV{'httpref.'.$origuri};
+	my $refuri=$ENV{'httpref.'.$orguri};
 	if ($refuri) {
 	    if ($refuri =~ m|^/adm/|) {
 		$thisallowed='F';
@@ -3716,8 +3738,11 @@ sub is_locked {
     my @check;
     my $is_locked;
     push @check, $file_name;
-    my %locked = &Apache::lonnet::get('file_permissions',\@check,
-                                        $ENV{'user.domain'},$ENV{'user.name'});
+    my %locked = &get('file_permissions',\@check,
+		      $ENV{'user.domain'},$ENV{'user.name'});
+    my ($tmp)=keys(%locked);
+    if ($tmp=~/^error:/) { undef(%locked); }
+
     if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'true';
     } else {
@@ -3729,11 +3754,14 @@ sub is_locked {
 
 sub mark_as_readonly {
     my ($domain,$user,$files,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+    my ($tmp)=keys(%current_permissions);
+    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);
     }
-    &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
+    &put('file_permissions',\%current_permissions,$domain,$user);
     return;
 }
 
@@ -3810,7 +3838,10 @@ sub files_not_in_path {
 
 sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+    my ($tmp)=keys(%current_permissions);
+    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     my @readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){
@@ -3829,7 +3860,10 @@ sub get_marked_as_readonly {
 
 sub get_marked_as_readonly_hash {
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+    my ($tmp)=keys(%current_permissions);
+    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
     my %readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){
@@ -3850,8 +3884,11 @@ sub unmark_as_readonly {
     # unmarks all files locked by $what 
     # for portfolio submissions, $what contains $crsid and $symb
     my ($domain,$user,$what) = @_;
-    my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
-    my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what);
+    my %current_permissions = &dump('file_permissions',$domain,$user);
+    my ($tmp)=keys(%current_permissions);
+    if ($tmp=~/^error:/) { undef(%current_permissions); }
+
+    my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
     foreach my $file(@readonly_files){
         my $current_locks = $current_permissions{$file};
         my @new_locks;
@@ -3866,12 +3903,12 @@ sub unmark_as_readonly {
                 $current_permissions{$file} = \@new_locks;
             } else {
                 push(@del_keys, $file);
-                &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user);
+                &del('file_permissions',\@del_keys, $domain, $user);
                 delete $current_permissions{$file};
             }
         }
     }
-    &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
+    &put('file_permissions',\%current_permissions,$domain,$user);
     return;
 }
 
@@ -4146,7 +4183,8 @@ sub EXT {
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
-	    if (defined($Apache::lonhomework::parsing_a_problem)) {
+	    if (defined($Apache::lonhomework::parsing_a_problem) ||
+		defined($Apache::lonhomework::parsing_a_task)) {
 		return $Apache::lonhomework::history{$qualifierrest};
 	    } else {
 		my %restored;
@@ -4470,7 +4508,7 @@ sub metadata {
 		    } else {
 			$metaentry{':packages'}=$package.$keyroot;
 		    }
-		    foreach (keys %packagetab) {
+		    foreach (sort keys %packagetab) {
 			my $part=$keyroot;
 			$part=~s/^\_//;
 			if ($_=~/^\Q$package\E\&/ || 
@@ -4687,7 +4725,23 @@ sub gettitle {
     if (!$title) { $title=(split('/',$urlsymb))[-1]; }    
     return $title;
 }
-    
+
+sub get_slot {
+    my ($which,$cnum,$cdom)=@_;
+    if (!$cnum || !$cdom) {
+	(undef,my $courseid)=&Apache::lonxml::whichuser();
+	$cdom=$ENV{'course.'.$courseid.'.domain'};
+	$cnum=$ENV{'course.'.$courseid.'.num'};
+    }
+    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}};
+    }
+    return $slotinfo{$which};
+}
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -4980,8 +5034,9 @@ sub validCODE {
 
 sub getCODE {
     if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
-    if (defined($Apache::lonhomework::parsing_a_problem) &&
-	&validCODE($Apache::lonhomework::history{'resource.CODE'})) {
+    if ( (defined($Apache::lonhomework::parsing_a_problem) ||
+	  defined($Apache::lonhomework::parsing_a_task) ) &&
+	 &validCODE($Apache::lonhomework::history{'resource.CODE'})) {
 	return $Apache::lonhomework::history{'resource.CODE'};
     }
     return undef;
@@ -5608,6 +5663,8 @@ BEGIN {
        }
     }
     close($config);
+    # FIXME: dev server don't want this, production servers _do_ want this
+    #&get_iphost();
 }
 
 sub get_iphost {