--- loncom/lonnet/perl/lonnet.pm 2000/11/07 17:20:10 1.59 +++ loncom/lonnet/perl/lonnet.pm 2000/11/15 23:25:59 1.64 @@ -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,11/15 Gerd Kortemeyer package Apache::lonnet; @@ -370,6 +369,9 @@ sub subscribe { return 'not_found'; } my $answer=reply("sub:$fname",$home); + if (($answer eq 'con_lost') || ($answer eq 'rejected')) { + $answer.=' by '.$home; + } return $answer; } @@ -381,14 +383,14 @@ sub repcopy { my $transname="$filename.in.transfer"; if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); - if ($remoteurl eq 'con_lost') { - &logthis("Subscribe returned con_lost: $filename"); + if ($remoteurl =~ /^con_lost by/) { + &logthis("Subscribe returned $remoteurl: $filename"); return HTTP_SERVICE_UNAVAILABLE; } elsif ($remoteurl eq 'not_found') { &logthis("Subscribe returned not_found: $filename"); return HTTP_NOT_FOUND; - } elsif ($remoteurl eq 'rejected') { - &logthis("Subscribe returned rejected: $filename"); + } elsif ($remoteurl =~ /^rejected by/) { + &logthis("Subscribe returned $remoteurl: $filename"); return FORBIDDEN; } elsif ($remoteurl eq 'directory') { return OK; @@ -546,6 +548,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 +973,6 @@ sub allowed { return 'F'; } -# ---------------------------------------------------------- Refresh State Info - -sub refreshstate { -} - # ----------------------------------------------------------------- Define Role sub definerole { @@ -1256,7 +1256,52 @@ 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}!~/^error\:/) { + 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'}); + if ($reply!~/^error\:/) { + 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 +1313,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 +1328,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 +1374,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 +1402,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 +1413,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 +1425,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 '';