--- loncom/lonnet/perl/lonnet.pm 2006/01/05 19:39:52 1.683.2.5 +++ loncom/lonnet/perl/lonnet.pm 2006/01/10 05:28:00 1.691 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683.2.5 2006/01/05 19:39:52 albertel Exp $ +# $Id: lonnet.pm,v 1.691 2006/01/10 05:28:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -271,7 +271,7 @@ sub transfer_profile_to_env { my %Remove; for ($envi=0;$envi<=$#profile;$envi++) { chomp($profile[$envi]); - my ($envname,$envvalue)=split(/=/,$profile[$envi]); + my ($envname,$envvalue)=split(/=/,$profile[$envi],2); $env{$envname} = $envvalue; if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { if ($time < time-300) { @@ -323,7 +323,7 @@ sub appenv { for (my $i=0; $i<=$#oldenv; $i++) { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { - my ($name,$value)=split(/=/,$oldenv[$i]); + my ($name,$value)=split(/=/,$oldenv[$i],2); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -382,7 +382,7 @@ sub delenv { } foreach (@oldenv) { if ($_=~/^$delthis/) { - my ($key,undef) = split('=',$_); + my ($key,undef) = split('=',$_,2); delete($env{$key}); } else { print $fh $_; @@ -1280,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: +# or /adm/notfound.html if failure to upload occurse sub userfileupload { @@ -3729,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; } @@ -4813,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(); } } @@ -4832,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; @@ -4853,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, @@ -4933,6 +4958,32 @@ sub EXT { 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); @@ -6234,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 {