--- loncom/lonnet/perl/lonnet.pm 2000/11/02 17:42:09 1.58
+++ loncom/lonnet/perl/lonnet.pm 2000/11/14 15:58:39 1.62
@@ -43,7 +43,6 @@
# state string
# condval(index) : value of condition index based on state
# EXT(name) : value of a variable
-# refreshstate() : refresh the state information string
# 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,11/2 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 {
@@ -1256,7 +1253,49 @@ sub EXT {
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 EXT {
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 EXT {
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 {
@@ -1319,6 +1368,7 @@ sub symbread {
my %hash;
my %bighash;
my $syval='';
+ my $parms='';
if (($ENV{'request.course.fn'}) && ($thisfn)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
&GDBM_READER,0640)) {
@@ -1346,6 +1396,7 @@ sub symbread {
if ($#possibilities==0) {
# ----------------------------------------------- There is only one possibility
my ($mapid,$resid)=split(/\./,$ids);
+ $parms=$bighash{'param_'.$ids};
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
} else {
# ------------------------------------------ There is more than one possibility
@@ -1356,6 +1407,7 @@ sub symbread {
my ($mapid,$resid)=split(/\./,$_);
if ($bighash{'map_type_'.$mapid} ne 'page') {
$realpossible++;
+ $parms=$bighash{'param_'.$_};
$syval=declutter($bighash{'map_id_'.$mapid}).
'___'.$resid;
}
@@ -1367,7 +1419,12 @@ sub symbread {
untie(%bighash)
}
}
- if ($syval) { return $syval.'___'.$thisfn; }
+ if ($syval) {
+ if ($parms) {
+ &appendparms($syval.'___'.$thisfn,$parms);
+ }
+ return $syval.'___'.$thisfn;
+ }
}
&appenv('request.ambiguous' => $thisfn);
return '';
@@ -1418,12 +1475,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/..