--- loncom/lonnet/perl/lonnet.pm 2005/03/21 18:53:51 1.614 +++ 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.614 2005/03/21 18:53:51 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 { @@ -3717,8 +3740,8 @@ sub is_locked { push @check, $file_name; my %locked = &get('file_permissions',\@check, $ENV{'user.domain'},$ENV{'user.name'}); -# my ($tmp)=keys(%locked); -# if ($tmp=~/^error:/) { undef(%locked); } + my ($tmp)=keys(%locked); + if ($tmp=~/^error:/) { undef(%locked); } if (ref($locked{$file_name}) eq 'ARRAY') { $is_locked = 'true'; @@ -3732,8 +3755,8 @@ sub is_locked { sub mark_as_readonly { my ($domain,$user,$files,$what) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); -# my ($tmp)=keys(%current_permissions); -# if ($tmp=~/^error:/) { undef(%current_permissions); } + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } foreach my $file (@{$files}) { push(@{$current_permissions{$file}},$what); @@ -3816,8 +3839,8 @@ sub files_not_in_path { sub get_marked_as_readonly { my ($domain,$user,$what) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); -# my ($tmp)=keys(%current_permissions); -# if ($tmp=~/^error:/) { undef(%current_permissions); } + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } my @readonly_files; while (my ($file_name,$value) = each(%current_permissions)) { @@ -3838,8 +3861,8 @@ sub get_marked_as_readonly { sub get_marked_as_readonly_hash { my ($domain,$user,$what) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); -# my ($tmp)=keys(%current_permissions); -# if ($tmp=~/^error:/) { undef(%current_permissions); } + my ($tmp)=keys(%current_permissions); + if ($tmp=~/^error:/) { undef(%current_permissions); } my %readonly_files; while (my ($file_name,$value) = each(%current_permissions)) { @@ -3862,8 +3885,8 @@ sub unmark_as_readonly { # for portfolio submissions, $what contains $crsid and $symb my ($domain,$user,$what) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); -# my ($tmp)=keys(%current_permissions); -# if ($tmp=~/^error:/) { undef(%current_permissions); } + 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){ @@ -4160,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; @@ -4713,7 +4737,10 @@ sub get_slot { &Apache::lonhomework::showhash(%slotinfo); my ($tmp)=keys(%slotinfo); if ($tmp=~/^error:/) { return (); } - return %{$slotinfo{$which}}; + if (ref($slotinfo{$which}) eq 'HASH') { + return %{$slotinfo{$which}}; + } + return $slotinfo{$which}; } # ------------------------------------------------- Update symbolic store links @@ -5007,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; @@ -5635,6 +5663,8 @@ BEGIN { } } close($config); + # FIXME: dev server don't want this, production servers _do_ want this + #&get_iphost(); } sub get_iphost {