--- loncom/lonnet/perl/lonnet.pm 2000/10/31 22:32:32 1.57 +++ loncom/lonnet/perl/lonnet.pm 2000/11/14 14:58:59 1.61 @@ -42,8 +42,7 @@ # directcondval(index) : reading condition value of single condition from # state string # condval(index) : value of condition index based on state -# varval(name) : value of a variable -# refreshstate() : refresh the state information string +# EXT(name) : value of a variable # symblist(map,hash) : Updates symbolic storage links # symbread([filename]) : returns the data handle (filename optional) # rndseed() : returns a random seed @@ -68,7 +67,7 @@ # 10/04 Gerd Kortemeyer # 10/04 Guy Albertelli # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, -# 10/30,10/31 Gerd Kortemeyer +# 10/30,10/31,11/2,11/14 Gerd Kortemeyer package Apache::lonnet; @@ -546,6 +545,9 @@ sub coursedescription { $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; $envhash{'course.'.$normalid.'.last_cache'}=time; + $envhash{'course.'.$normalid.'.home'}=$chome; + $envhash{'course.'.$normalid.'.domain'}=$cdomain; + $envhash{'course.'.$normalid.'.num'}=$cnum; &appenv(%envhash); return %returnhash; } @@ -968,11 +970,6 @@ sub allowed { return 'F'; } -# ---------------------------------------------------------- Refresh State Info - -sub refreshstate { -} - # ----------------------------------------------------------------- Define Role sub definerole { @@ -1192,7 +1189,7 @@ sub condval { # --------------------------------------------------------- Value of a Variable -sub varval { +sub EXT { my $varname=shift; my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; @@ -1256,7 +1253,49 @@ sub varval { return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'. $spacequalifierrest}; } elsif ($realm eq 'resource') { -# ----------------------------------------------------------- resource metadata + if ($ENV{'request.course.id'}) { +# ----------------------------------------------------- Cascading lookup scheme + my $reslevel= + $ENV{'request.course.id'}.'.'.&symbread().'.'.$spacequalifierrest; + my $seclevel= + $ENV{'request.course.id'}.'.'. + $ENV{'request.course.sec'}.'.'.$spacequalifierrest; + my $courselevel= + $ENV{'request.course.id'}.'.'.$spacequalifierrest; + +# ----------------------------------------------------------- first, check user + my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel)); + if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; } + if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; } + if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } + +# -------------------------------------------------------- second, check course + my $section=''; + if ($ENV{'request.course.sec'}) { + $section='_'.$ENV{'request.course.sec'}; + } + my $reply=&reply('get:'. + $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'. + $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}. + ':resourcedata:'. + escape($reslevel).':'.escape($seclevel).':'.escape($courselevel), + $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}); + map { + my ($name,$value)=split(/\=/,$_); + $resourcedata{unescape($name)}=unescape($value); + } split(/\&/,$reply); + if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; } + if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; } + if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } + +# ------------------------------------------------------ third, check map parms + + if ($ENV{'resource.parms.'.$reslevel}) { + return $ENV{'resource.parms.'.$reslevel}; + } + } + +# --------------------------------------------- last, look in resource metadata my $uri=&declutter($ENV{'request.filename'}); my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta'; if (-e $filename) { @@ -1268,13 +1307,8 @@ sub varval { if (join('',@content)=~ /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) { return $1; - } else { - return ''; - } - } - } elsif ($realm eq 'userdata') { - my $uhome=&homeserver($qualifier,$space); -# ----------------------------------------------- userdata.domain.name.resource + } + } # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment @@ -1288,6 +1322,21 @@ sub varval { return ''; } +# ---------------------------------------- Append resource parms to environment + +sub appendparms { + my ($symb,$parms)=@_; + my %storehash=(); + my $prefix='resource.parms.'.$ENV{'request.course.id'}.'.'.$symb; + map { + my ($typename,$value)=split(/\=/,$_); + my ($type,$name)=split(/\:/,$typename); + $storehash{$prefix.'.'.unescape($name)}=unescape($value); + $storehash{$prefix.'.'.unescape($name).'.type'}=unescape($type); + } split(/\&/,$parms); + &appenv(%storehash); +} + # ------------------------------------------------- Update symbolic store links sub symblist { @@ -1418,12 +1467,17 @@ sub filelocation { my ($dir,$file) = @_; my $location; $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces - $file=~s/^$perlvar{'lonDocRoot'}//; - $file=~s:^/*res::; - if ( !( $file =~ m:^/:) ) { - $location = $dir. '/'.$file; + if ($file=~m:^/~:) { # is a contruction space reference + $location = $file; + $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; } else { - $location = '/home/httpd/html/res'.$file; + $file=~s/^$perlvar{'lonDocRoot'}//; + $file=~s:^/*res::; + if ( !( $file =~ m:^/:) ) { + $location = $dir. '/'.$file; + } else { + $location = '/home/httpd/html/res'.$file; + } } $location=~s://+:/:g; # remove duplicate / while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..