--- loncom/lonnet/perl/lonnet.pm 2006/03/07 02:46:03 1.719 +++ loncom/lonnet/perl/lonnet.pm 2006/04/06 19:14:50 1.726 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.719 2006/03/07 02:46:03 banghart Exp $ +# $Id: lonnet.pm,v 1.726 2006/04/06 19:14:50 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -260,6 +260,13 @@ sub critical { sub transfer_profile_to_env { my ($lonidsdir,$handle)=@_; + if (!defined($lonidsdir)) { + $lonidsdir = $perlvar{'lonIDsDir'}; + } + if (!defined($handle)) { + ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| ); + } + my @profile; { open(my $idf,"$lonidsdir/$handle.id"); @@ -272,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) { @@ -324,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; } @@ -336,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); } @@ -348,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); @@ -381,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; @@ -843,6 +855,7 @@ sub save_cache { my ($r)=@_; if (! $r->is_initial_req()) { return DECLINED; } &purge_remembered(); + #&Apache::loncommon::validate_page(); undef(%env); return OK; } @@ -996,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 @@ -4733,6 +4746,12 @@ sub GetFileTimestamp { sub stat_file { my ($uri) = @_; $uri = &clutter($uri); + + # we want just the url part without the unneeded accessor url bits + 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) = @@ -4753,6 +4772,7 @@ sub stat_file { my ($result) = &dirlist($file,$udom,$uname,$dir); my @stats = split('&', $result); + if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { shift(@stats); #filename is first return @stats; @@ -5099,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); @@ -5236,10 +5253,7 @@ sub check_group_parms { 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); - } + my @groups = sort(split(/:/,$grouplist)); return @groups; }