--- loncom/lonnet/perl/lonnet.pm 2000/11/14 02:39:30 1.60 +++ loncom/lonnet/perl/lonnet.pm 2000/11/16 12:00:01 1.65 @@ -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,11/14 Gerd Kortemeyer +# 10/30,10/31,11/2,11/14,11/15,11/16 Gerd Kortemeyer package Apache::lonnet; @@ -123,8 +122,7 @@ sub reply { my ($cmd,$server)=@_; my $answer=subreply($cmd,$server); if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); } - if (($answer=~/^error:/) || ($answer=~/^refused/) || - ($answer=~/^rejected/)) { + if (($answer=~/^refused/) || ($answer=~/^rejected/)) { &logthis("<font color=blue>WARNING:". " $cmd to $server returned $answer</font>"); } @@ -370,6 +368,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 +382,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; @@ -971,11 +972,6 @@ sub allowed { return 'F'; } -# ---------------------------------------------------------- Refresh State Info - -sub refreshstate { -} - # ----------------------------------------------------------------- Define Role sub definerole { @@ -1261,8 +1257,9 @@ sub EXT { } elsif ($realm eq 'resource') { if ($ENV{'request.course.id'}) { # ----------------------------------------------------- Cascading lookup scheme + my $symbparm=&symbread().'.'.$spacequalifierrest; my $reslevel= - $ENV{'request.course.id'}.'.'.&symbread().'.'.$spacequalifierrest; + $ENV{'request.course.id'}.'.'.$symbparm; my $seclevel= $ENV{'request.course.id'}.'.'. $ENV{'request.course.sec'}.'.'.$spacequalifierrest; @@ -1270,11 +1267,12 @@ sub EXT { $ENV{'request.course.id'}.'.'.$spacequalifierrest; # ----------------------------------------------------------- first, check user - my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel)); + 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'}) { @@ -1286,19 +1284,25 @@ sub EXT { ':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{$seclevel}) { return $resourcedata{$seclevel}; } if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } + } # ------------------------------------------------------ third, check map parms - - if ($ENV{'resource.parms.'.$reslevel}) { - return $ENV{'resource.parms.'.$reslevel}; + my %parmhash=(); + my $thisparm=''; + if (tie(%parmhash,'GDBM_File', + $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) { + $thisparm=$parmhash{$symbparm}; + untie(%parmhash); } + if ($thisparm) { return $thisparm; } } # --------------------------------------------- last, look in resource metadata @@ -1380,6 +1384,9 @@ sub symbread { &GDBM_READER,0640)) { # ---------------------------------------------- Get ID(s) for current resource my $ids=$bighash{'ids_/res/'.$thisfn}; + unless ($ids) { + $ids=$bighash{'ids_/'.$thisfn}; + } if ($ids) { # ------------------------------------------------------------------- Has ID(s) my @possibilities=split(/\,/,$ids); @@ -1407,7 +1414,9 @@ sub symbread { untie(%bighash) } } - if ($syval) { return $syval.'___'.$thisfn; } + if ($syval) { + return $syval.'___'.$thisfn; + } } &appenv('request.ambiguous' => $thisfn); return '';