--- loncom/lonnet/perl/lonnet.pm 2006/03/27 23:00:18 1.722 +++ loncom/lonnet/perl/lonnet.pm 2006/04/06 20:27:35 1.727 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.722 2006/03/27 23:00:18 albertel Exp $ +# $Id: lonnet.pm,v 1.727 2006/04/06 20:27:35 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -279,6 +279,8 @@ sub transfer_profile_to_env { for ($envi=0;$envi<=$#profile;$envi++) { chomp($profile[$envi]); my ($envname,$envvalue)=split(/=/,$profile[$envi],2); + $envname=&unescape($envname); + $envvalue=&unescape($envvalue); $env{$envname} = $envvalue; if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { if ($time < time-300) { @@ -331,6 +333,8 @@ sub appenv { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { my ($name,$value)=split(/=/,$oldenv[$i],2); + $name=&unescape($name); + $value=&unescape($value); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -343,7 +347,7 @@ sub appenv { } my $newname; foreach $newname (keys %newenv) { - print $fh "$newname=$newenv{$newname}\n"; + print $fh &escape($newname).'='.&escape($newenv{$newname})."\n"; } close($fh); } @@ -355,7 +359,6 @@ sub appenv { sub delenv { my $delthis=shift; - my %newenv=(); if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { &logthis("WARNING: ". "Attempt to delete from environment ".$delthis); @@ -388,8 +391,10 @@ sub delenv { return 'error: '.$!; } foreach my $cur_key (@oldenv) { - if ($cur_key=~/^$delthis/) { - my ($key,undef) = split('=',$cur_key,2); + my $unescaped_cur_key = &unescape($cur_key); + if ($unescaped_cur_key=~/^$delthis/) { + my ($key) = split('=',$cur_key,2); + $key = &unescape($key); delete($env{$key}); } else { print $fh $cur_key; @@ -1004,13 +1009,13 @@ sub retrievestudentphoto { # -------------------------------------------------------------------- New chat sub chatsend { - my ($newentry,$anon)=@_; + my ($newentry,$anon,$group)=@_; my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; &reply('chatsend:'.$cdom.':'.$cnum.':'. &escape($env{'user.domain'}.':'.$env{'user.name'}.':'.$anon.':'. - &escape($newentry)),$chome); + &escape($newentry)).':'.$group,$chome); } # ------------------------------------------ Find current version of a resource @@ -3987,7 +3992,7 @@ sub get_users_groups { my $grouplist; foreach my $key (keys %roleshash) { if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { - unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership + unless ($roleshash{$key} =~ /_\d+_\-1$/) { # deleted membership $grouplist .= $1.':'; } } @@ -4743,11 +4748,10 @@ sub stat_file { $uri = &clutter($uri); # we want just the url part without the unneeded accessor url bits - if ($file =~ m-^/adm/-) { - $file=~s-^/adm/wrapper/-/-; - $file=~s-^/adm/coursedocs/showdoc/-/-; + if ($uri =~ m-^/adm/-) { + $uri=~s-^/adm/wrapper/-/-; + $uri=~s-^/adm/coursedocs/showdoc/-/-; } - my ($udom,$uname,$file,$dir); if ($uri =~ m-^/(uploaded|editupload)/-) { ($udom,$uname,$file) = @@ -5115,9 +5119,6 @@ sub EXT { ($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);