--- loncom/lonnet/perl/lonnet.pm 2000/10/06 22:43:34 1.38
+++ loncom/lonnet/perl/lonnet.pm 2000/10/16 09:42:50 1.46
@@ -36,16 +36,19 @@
# coursedescription(id) : returns and caches course description for id
# repcopy(filename) : replicate file
# dirlist(url) : gets a directory listing
+# 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
# symblist(map,hash) : Updates symbolic storage links
-# symbread(filename) : returns the data handle
+# symbread([filename]) : returns the data handle (filename optional)
# rndseed() : returns a random seed
# getfile(filename) : returns the contents of filename, or a -1 if it can't
# be found, replicates and subscribes to the file
# filelocation(dir,file) : returns a farily clean absolute reference to file
# from the directory dir
+# hreflocation(dir,file) : same as filelocation, but for hrefs
#
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
@@ -60,7 +63,7 @@
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
# 10/04 Gerd Kortemeyer
# 10/04 Guy Albertelli
-# 10/06 Gerd Kortemeyer
+# 10/06,10/09,10/10,10/11,10/14 Gerd Kortemeyer
package Apache::lonnet;
@@ -429,7 +432,7 @@ sub log {
sub store {
my %storehash=@_;
my $symb;
- unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; }
+ unless ($symb=escape(&symbread())) { return ''; }
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $namevalue='';
@@ -446,7 +449,7 @@ sub store {
sub restore {
my $symb;
- unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; }
+ unless ($symb=escape(&symbread())) { return ''; }
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $answer=reply(
@@ -594,10 +597,11 @@ sub get {
$ENV{'user.home'});
my @pairs=split(/\&/,$rep);
my %returnhash=();
+ my $i=0;
map {
- my ($key,$value)=split(/=/,$_);
- $returnhash{unescape($key)}=unescape($value);
- } @pairs;
+ $returnhash{$_}=unescape($pairs[$i]);
+ $i++;
+ } @storearr;
return %returnhash;
}
@@ -655,10 +659,11 @@ sub eget {
$ENV{'user.home'});
my @pairs=split(/\&/,$rep);
my %returnhash=();
+ my $i=0;
map {
- my ($key,$value)=split(/=/,$_);
- $returnhash{unescape($key)}=unescape($value);
- } @pairs;
+ $returnhash{$_}=unescape($pairs[$i]);
+ $i++;
+ } @storearr;
return %returnhash;
}
@@ -757,7 +762,7 @@ sub allowed {
# Restricted by state?
if ($thisallowed=~/X/) {
- if (&condval($uricond)>1) {
+ if (&condval($uricond)) {
return '2';
} else {
return '';
@@ -940,6 +945,15 @@ sub dirlist {
# -------------------------------------------------------- Value of a Condition
+sub directcondval {
+ my $number=shift;
+ if ($ENV{'user.state.'.$ENV{'request.course.id'}}) {
+ return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1);
+ } else {
+ return 2;
+ }
+}
+
sub condval {
my $condidx=shift;
my $result=0;
@@ -960,8 +974,7 @@ sub condval {
} elsif (($_ eq '&') || ($_ eq '|')) {
$operand=$_;
} else {
- my $new=
- substr($ENV{'user.state.'.$ENV{'request.course.id'}},$_,1);
+ my $new=directcondval($_);
if ($operand eq '&') {
$result=$result>$new?$new:$result;
} else {
@@ -1017,11 +1030,15 @@ sub symblist {
# ------------------------------------------------------ Return symb list entry
sub symbread {
- my $thisfn=declutter(shift);
+ my $thisfn=shift;
+ unless ($thisfn) {
+ $thisfn=$ENV{'request.filename'};
+ }
+ $thisfn=declutter($thisfn);
my %hash;
my %bighash;
my $syval='';
- if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) {
+ if (($ENV{'request.course.fn'}) && ($thisfn)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
&GDBM_READER,0640)) {
$syval=$hash{$thisfn};
@@ -1031,6 +1048,7 @@ sub symbread {
if ($syval) {
unless ($syval=~/\_\d+$/) {
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
+ &appenv('request.ambiguous' => $thisfn);
return '';
}
$syval.=$1;
@@ -1044,11 +1062,25 @@ sub symbread {
if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
my @possibilities=split(/\,/,$ids);
- if ($#possibilities==1) {
+ if ($#possibilities==0) {
+# ----------------------------------------------- There is only one possibility
my ($mapid,$resid)=split(/\./,$ids);
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
} else {
- $syval='';
+# ------------------------------------------ There is more than one possibility
+ my $realpossible=0;
+ map {
+ my $file=$bighash{'src_'.$_};
+ if (&allowed('bre',$file)) {
+ my ($mapid,$resid)=split(/\./,$_);
+ if ($bighash{'map_type_'.$mapid} ne 'page') {
+ $realpossible++;
+ $syval=declutter($bighash{'map_id_'.$mapid}).
+ '___'.$resid;
+ }
+ }
+ } @possibilities;
+ if ($realpossible!=1) { $syval=''; }
}
}
untie(%bighash)
@@ -1056,6 +1088,7 @@ sub symbread {
}
if ($syval) { return $syval.'___'.$thisfn; }
}
+ &appenv('request.ambiguous' => $thisfn);
return '';
}
@@ -1075,7 +1108,7 @@ sub numval {
sub rndseed {
my $symb;
- unless ($symb=&symbread($ENV{'request.filename'})) { return ''; }
+ unless ($symb=&symbread()) { return time; }
my $symbchck=unpack("%32C*",$symb);
my $symbseed=numval($symb)%$symbchck;
my $namechck=unpack("%32C*",$ENV{'user.name'});
@@ -1112,11 +1145,21 @@ sub filelocation {
$location = '/home/httpd/html/res'.$file;
}
$location=~s://+:/:g; # remove duplicate /
- while ($location=~m:/../:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
-
+ while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
return $location;
}
+sub hreflocation {
+ my ($dir,$file)=@_;
+ unless (($_=~/^http:\/\//i) || ($_=~/^\//)) {
+ my $finalpath=filelocation($dir,$file);
+ $finalpath=~s/^\/home\/httpd\/html//;
+ return $finalpath;
+ } else {
+ return $file;
+ }
+}
+
# ------------------------------------------------------------- Declutters URLs
sub declutter {