version 1.35, 2000/10/04 15:59:07
|
version 1.40, 2000/10/09 20:26:17
|
Line 28
|
Line 28
|
# restore : returns hash for this url |
# restore : returns hash for this url |
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# del(namesp,array) : deletes keys out of arry from namesp |
# del(namesp,array) : deletes keys out of array from namesp |
# put(namesp,hash) : stores hash in namesp |
# put(namesp,hash) : stores hash in namesp |
# dump(namesp) : dumps the complete namespace into a hash |
# dump(namesp) : dumps the complete namespace into a hash |
# ssi(url,hash) : does a complete request cycle on url to localhost, posts |
# ssi(url,hash) : does a complete request cycle on url to localhost, posts |
Line 36
|
Line 36
|
# coursedescription(id) : returns and caches course description for id |
# coursedescription(id) : returns and caches course description for id |
# repcopy(filename) : replicate file |
# repcopy(filename) : replicate file |
# dirlist(url) : gets a directory listing |
# 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 |
# condval(index) : value of condition index based on state |
# varval(name) : value of a variable |
# varval(name) : value of a variable |
# refreshstate() : refresh the state information string |
# refreshstate() : refresh the state information string |
# symblist(map,hash) : Updates symbolic storage links |
# symblist(map,hash) : Updates symbolic storage links |
|
# symbread(filename) : returns the data handle |
# rndseed() : returns a random seed |
# 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 |
# |
# |
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, |
# 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, |
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, |
Line 52
|
Line 59
|
# 06/26 Ben Tyszka |
# 06/26 Ben Tyszka |
# 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer |
# 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer |
# 08/14 Ben Tyszka |
# 08/14 Ben Tyszka |
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30, |
# 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 Gerd Kortemeyer |
|
# 10/04 Guy Albertelli |
|
# 10/06,10/09 Gerd Kortemeyer |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
Line 422 sub log {
|
Line 431 sub log {
|
sub store { |
sub store { |
my %storehash=@_; |
my %storehash=@_; |
my $symb; |
my $symb; |
unless ($symb=escape(&symbread())) { return ''; } |
unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; } |
my $namespace; |
my $namespace; |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
my $namevalue=''; |
my $namevalue=''; |
Line 439 sub store {
|
Line 448 sub store {
|
|
|
sub restore { |
sub restore { |
my $symb; |
my $symb; |
unless ($symb=escape(&symbread())) { return ''; } |
unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; } |
my $namespace; |
my $namespace; |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
my $answer=reply( |
my $answer=reply( |
Line 481 sub coursedescription {
|
Line 490 sub coursedescription {
|
} split(/\&/,$rep); |
} split(/\&/,$rep); |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$ENV{'user.name.'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
put ('coursedescriptions',%cachehash); |
put ('coursedescriptions',%cachehash); |
return %returnhash; |
return %returnhash; |
} |
} |
Line 933 sub dirlist {
|
Line 942 sub dirlist {
|
|
|
# -------------------------------------------------------- Value of a Condition |
# -------------------------------------------------------- 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 { |
sub condval { |
my $condidx=shift; |
my $condidx=shift; |
my $result=0; |
my $result=0; |
Line 953 sub condval {
|
Line 971 sub condval {
|
} elsif (($_ eq '&') || ($_ eq '|')) { |
} elsif (($_ eq '&') || ($_ eq '|')) { |
$operand=$_; |
$operand=$_; |
} else { |
} else { |
my $new= |
my $new=directcondval($_); |
substr($ENV{'user.state.'.$ENV{'request.course.id'}},$_,1); |
|
if ($operand eq '&') { |
if ($operand eq '&') { |
$result=$result>$new?$new:$result; |
$result=$result>$new?$new:$result; |
} else { |
} else { |
Line 1010 sub symblist {
|
Line 1027 sub symblist {
|
# ------------------------------------------------------ Return symb list entry |
# ------------------------------------------------------ Return symb list entry |
|
|
sub symbread { |
sub symbread { |
|
my $thisfn=declutter(shift); |
my %hash; |
my %hash; |
my $syval; |
my %bighash; |
|
my $syval=''; |
if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) { |
if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) { |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
&GDBM_READER,0640)) { |
&GDBM_READER,0640)) { |
my $thisfn=declutter($ENV{'request.filename'}); |
|
$syval=$hash{$thisfn}; |
$syval=$hash{$thisfn}; |
if (untie(%hash)) { |
untie(%hash); |
unless ($syval=~/\_\d+$/) { |
} |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
# ---------------------------------------------------------- There was an entry |
return ''; |
if ($syval) { |
} |
unless ($syval=~/\_\d+$/) { |
$syval.=$1; |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
} |
return ''; |
$syval.='___'.$thisfn; |
} |
return $syval; |
$syval.=$1; |
} |
} |
|
} else { |
|
# ------------------------------------------------------- Was not in symb table |
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
|
&GDBM_READER,0640)) { |
|
# ---------------------------------------------- Get ID(s) for current resource |
|
my $ids=$bighash{'ids_/res/'.$thisfn}; |
|
if ($ids) { |
|
# ------------------------------------------------------------------- Has ID(s) |
|
my @possibilities=split(/\,/,$ids); |
|
if ($#possibilities==0) { |
|
# ----------------------------------------------- There is only one possibility |
|
my ($mapid,$resid)=split(/\./,$ids); |
|
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; |
|
} else { |
|
# ------------------------------------------ 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) |
|
} |
} |
} |
|
if ($syval) { return $syval.'___'.$thisfn; } |
} |
} |
return ''; |
return ''; |
} |
} |
Line 1048 sub numval {
|
Line 1099 sub numval {
|
|
|
sub rndseed { |
sub rndseed { |
my $symb; |
my $symb; |
unless ($symb=&symbread()) { return ''; } |
unless ($symb=&symbread($ENV{'request.filename'})) { return ''; } |
my $symbchck=unpack("%32C*",$symb); |
my $symbchck=unpack("%32C*",$symb); |
my $symbseed=numval($symb)%$symbchck; |
my $symbseed=numval($symb)%$symbchck; |
my $namechck=unpack("%32C*",$ENV{'user.name'}); |
my $namechck=unpack("%32C*",$ENV{'user.name'}); |
Line 1061 sub rndseed {
|
Line 1112 sub rndseed {
|
.$symbchck); |
.$symbchck); |
} |
} |
|
|
|
# ------------------------------------------------------------ Serves up a file |
|
# returns either the contents of the file or a -1 |
|
sub getfile { |
|
my $file=shift; |
|
&repcopy($file); |
|
if (! -e $file ) { return -1; }; |
|
my $fh=Apache::File->new($file); |
|
my $a=''; |
|
while (<$fh>) { $a .=$_; } |
|
return $a |
|
} |
|
|
|
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; |
|
} else { |
|
$location = '/home/httpd/html/res'.$file; |
|
} |
|
$location=~s://+:/:g; # remove duplicate / |
|
while ($location=~m:/../:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. |
|
|
|
return $location; |
|
} |
|
|
# ------------------------------------------------------------- Declutters URLs |
# ------------------------------------------------------------- Declutters URLs |
|
|
sub declutter { |
sub declutter { |