--- loncom/lonnet/perl/lonnet.pm 2000/11/14 14:58:59 1.61
+++ loncom/lonnet/perl/lonnet.pm 2000/11/24 19:59:31 1.69
@@ -67,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,11/20,11/21,11/22,11/25 Gerd Kortemeyer
package Apache::lonnet;
@@ -122,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>");
}
@@ -369,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;
}
@@ -380,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;
@@ -774,8 +776,9 @@ sub allowed {
}
# Course: uri itself is a course
-
- if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
+ my $courseuri=$uri;
+ $courseuri=~s/\_(\d)/\/$1/;
+ if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}
=~/$priv\&([^\:]*)/) {
$thisallowed.=$1;
}
@@ -1191,6 +1194,7 @@ sub condval {
sub EXT {
my $varname=shift;
+ unless ($varname) { return ''; }
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
my $rest;
if ($therest[0]) {
@@ -1255,20 +1259,42 @@ sub EXT {
} elsif ($realm eq 'resource') {
if ($ENV{'request.course.id'}) {
# ----------------------------------------------------- Cascading lookup scheme
- my $reslevel=
- $ENV{'request.course.id'}.'.'.&symbread().'.'.$spacequalifierrest;
+ my $symbp=&symbread();
+ my $mapp=(split(/\_\_\_/,$symbp))[0];
+
+ my $symbparm=$symbp.'.'.$spacequalifierrest;
+ my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+
my $seclevel=
- $ENV{'request.course.id'}.'.'.
- $ENV{'request.course.sec'}.'.'.$spacequalifierrest;
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$spacequalifierrest;
+ my $seclevelr=
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$symbparm;
+ my $seclevelm=
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$mapparm;
+
my $courselevel=
$ENV{'request.course.id'}.'.'.$spacequalifierrest;
+ my $courselevelr=
+ $ENV{'request.course.id'}.'.'.$symbparm;
+ my $courselevelm=
+ $ENV{'request.course.id'}.'.'.$mapparm;
+
# ----------------------------------------------------------- first, check user
- my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel));
- if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
- if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+ my %resourcedata=get('resourcedata',
+ ($courselevelr,$courselevelm,$courselevel));
+ if ($resourcedata{$courselevelr}!~/^error\:/) {
+
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+ }
# -------------------------------------------------------- second, check course
my $section='';
if ($ENV{'request.course.sec'}) {
@@ -1278,26 +1304,41 @@ sub EXT {
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
':resourcedata:'.
- escape($reslevel).':'.escape($seclevel).':'.escape($courselevel),
+ escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.
+ escape($courselevelr).':'.escape($courselevelm).':'.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{$seclevelr}) { return $resourcedata{$seclevelr}; }
+ if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }
if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
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
my $uri=&declutter($ENV{'request.filename'});
- my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
+ my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
if (-e $filename) {
my @content;
{
@@ -1322,21 +1363,6 @@ 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 {
@@ -1389,6 +1415,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);
@@ -1416,7 +1445,9 @@ sub symbread {
untie(%bighash)
}
}
- if ($syval) { return $syval.'___'.$thisfn; }
+ if ($syval) {
+ return $syval.'___'.$thisfn;
+ }
}
&appenv('request.ambiguous' => $thisfn);
return '';