--- loncom/lonnet/perl/lonnet.pm 2006/01/11 07:33:45 1.683.2.7 +++ loncom/lonnet/perl/lonnet.pm 2006/01/05 19:40:31 1.689 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683.2.7 2006/01/11 07:33:45 albertel Exp $ +# $Id: lonnet.pm,v 1.689 2006/01/05 19:40:31 albertel 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],2); + my ($envname,$envvalue)=split(/=/,$profile[$envi]); $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],2); + my ($name,$value)=split(/=/,$oldenv[$i]); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -382,7 +382,7 @@ sub delenv { } foreach (@oldenv) { if ($_=~/^$delthis/) { - my ($key,undef) = split('=',$_,2); + my ($key,undef) = split('=',$_); 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 { @@ -3405,8 +3412,7 @@ sub is_on_map { my $filename=$uriparts[$#uriparts]; my $pathname=$uri; $pathname=~s|/\Q$filename\E$||; - $pathname=~s/^adm\/wrapper\///; - $pathname=~s/^adm\/coursedocs\/showdoc\///; + $pathname=~s/^adm\/wrapper\///; #Trying to find the conditional for the file my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ /\&\Q$filename\E\:([\d\|]+)\&/); @@ -3730,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,7 +4823,8 @@ sub EXT { return $env{'course.'.$courseid.'.'.$spacequalifierrest}; } elsif ($realm eq 'resource') { - my $section; + my ($section,$group); + my @groups = (); if (defined($courseid) && $courseid eq $env{'request.course.id'}) { if (!$symbparm) { $symbparm=&symbread(); } } @@ -4833,14 +4844,29 @@ sub EXT { if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { $section=$env{'request.course.sec'}; + @groups=split(/:/,$env{'request.course.groups'}); + if (@groups > 0) { + @groups = sort(@groups); + $group = $groups[0]; + } } else { if (! defined($usection)) { $section=&getsection($udom,$uname,$courseid); } else { $section = $usection; } + my $grouplist = &get_users_groups($udom,$uname,$courseid); + if ($grouplist) { + @groups = split(/:/,$grouplist); + @groups = sort(@groups); + $group = $groups[0]; + } } + my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest; + my $grplevelr=$courseid.'.['.$group.'].'.$symbparm; + my $grplevelm=$courseid.'.['.$group.'].'.$mapparm; + my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; @@ -4858,8 +4884,17 @@ sub EXT { if (defined($userreply)) { return $userreply; } # ------------------------------------------------ second, check some of course + my $coursereply; + if (defined($group)) { + $coursereply = &resdata($env{'course.'.$courseid.'.num'}, + $env{'course.'.$courseid.'.domain'}, + 'course', + ($grplevelr,$grplevelm,$grplevel, + $courselevelr)); + 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, @@ -4976,8 +5011,7 @@ sub metadata { # if it is a non metadata possible uri return quickly if (($uri eq '') || (($uri =~ m|^/*adm/|) && - ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|) - && ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) || + ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || ($uri =~ m|home/[^/]+/public_html/|)) { return undef; @@ -5295,7 +5329,6 @@ sub symbverify { my $thisfn=$thisurl; # wrapper not part of symbs $thisfn=~s/^\/adm\/wrapper//; - $thisfn=~s/^\/adm\/coursedocs\/showdoc\///; $thisfn=&declutter($thisfn); # direct jump to resource in page or to a sequence - will construct own symbs if ($thisfn=~/\.(page|sequence)$/) { return 1; } @@ -5350,7 +5383,6 @@ sub symbclean { # remove wrapper $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; - $symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/; return $symb; } @@ -6085,8 +6117,6 @@ sub declutter { $thisfn=~s/^\///; $thisfn=~s/^res\///; $thisfn=~s/\?.+$//; - $thisfn=~s|^adm/wrapper/||; - $thisfn=~s|^adm/coursedocs/showdoc/||; return $thisfn; } @@ -6097,23 +6127,6 @@ sub clutter { unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { $thisfn='/res'.$thisfn; } - if ($thisfn !~m|/adm|) { - if ($thisfn =~ m|/ext/|) { - $thisfn='/adm/wrapper'.$thisfn; - } else { - my ($ext) = ($thisfn =~ /\.(\w+)$/); - my $embstyle=&Apache::loncommon::fileembstyle($ext); - if (($embstyle eq 'img') - || ($embstyle eq 'emb') - || ($embstyle eq 'wrp')) { - $thisfn='/adm/wrapper'.$thisfn; - } elsif ($embstyle eq 'ssi') { - #do nothing with these - } elsif ($thisfn!~/\.(sequence|page)$/) { - $thisfn='/adm/coursedocs/showdoc'.$thisfn; - } - } - } return $thisfn; } @@ -6257,7 +6270,7 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - &get_iphost(); + #&get_iphost(); } sub get_iphost {