--- loncom/lonnet/perl/lonnet.pm 2000/10/12 02:11:16 1.45
+++ loncom/lonnet/perl/lonnet.pm 2000/10/25 20:52:31 1.49
@@ -25,11 +25,13 @@
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
# appenv(hash) : adds hash to session environment
# store(hash) : stores hash permanently for this url
+# cstore(hash) : critical store
# restore : returns hash for this url
# 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
# del(namesp,array) : deletes keys out of array from namesp
# put(namesp,hash) : stores hash in namesp
+# cput(namesp,hash) : critical put
# dump(namesp) : dumps the complete namespace into a hash
# ssi(url,hash) : does a complete request cycle on url to localhost, posts
# hash
@@ -48,6 +50,8 @@
# 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
+# log(domain,user,home,msg) : write to permanent log for user
#
# 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,
@@ -62,7 +66,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,10/09,10/10,10/11 Gerd Kortemeyer
+# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25 Gerd Kortemeyer
package Apache::lonnet;
@@ -423,7 +427,7 @@ sub ssi {
sub log {
my ($dom,$nam,$hom,$what)=@_;
- return reply("log:$dom:$nam:$what",$hom);
+ return critical("log:$dom:$nam:$what",$hom);
}
# ----------------------------------------------------------------------- Store
@@ -444,6 +448,24 @@ sub store {
"$ENV{'user.home'}");
}
+# -------------------------------------------------------------- Critical Store
+
+sub cstore {
+ my %storehash=@_;
+ my $symb;
+ unless ($symb=escape(&symbread())) { return ''; }
+ my $namespace;
+ unless ($namespace=$ENV{'request.course.id'}) { return ''; }
+ my $namevalue='';
+ map {
+ $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
+ } keys %storehash;
+ $namevalue=~s/\&$//;
+ return critical(
+ "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
+ "$ENV{'user.home'}");
+}
+
# --------------------------------------------------------------------- Restore
sub restore {
@@ -470,6 +492,7 @@ sub restore {
sub coursedescription {
my $courseid=shift;
$courseid=~s/^\///;
+ $courseid=~s/\_/\//g;
my ($cdomain,$cnum)=split(/\//,$courseid);
my $chome=homeserver($cnum,$cdomain);
if ($chome ne 'no_host') {
@@ -645,6 +668,20 @@ sub put {
$ENV{'user.home'});
}
+# ------------------------------------------------------ critical put interface
+
+sub cput {
+ my ($namespace,%storehash)=@_;
+ my $items='';
+ map {
+ $items.=escape($_).'='.escape($storehash{$_}).'&';
+ } keys %storehash;
+ $items=~s/\&$//;
+ return critical
+ ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
+ $ENV{'user.home'});
+}
+
# -------------------------------------------------------------- eget interface
sub eget {
@@ -990,20 +1027,84 @@ sub condval {
# --------------------------------------------------------- Value of a Variable
sub varval {
- my ($realm,$space,@components)=split(/\./,shift);
- my $value='';
+ my $varname=shift;
+ my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
+ my $rest;
+ if ($therest[0]) {
+ $rest=join('.',@therest);
+ } else {
+ $rest='';
+ }
if ($realm eq 'user') {
- if ($space=~/^resource/) {
- $space=~s/^resource\[//;
- $space=~s/\]$//;
-
+# --------------------------------------------------------------- user.resource
+ if ($space eq 'resource') {
+# ----------------------------------------------------------------- user.access
+ } elsif ($space eq 'access') {
+ return &allowed($qualifier,$rest);
+# ------------------------------------------ user.preferences, user.environment
+ } elsif (($space eq 'preferences') || ($space eq 'environment')) {
+ return $ENV{join('.',('environment',$qualifier,$rest))};
+# ----------------------------------------------------------------- user.course
+ } elsif ($space eq 'course') {
+ return $ENV{join('.',('request.course',$qualifier))};
+# ------------------------------------------------------------------- user.role
+ } elsif ($space eq 'role') {
+ my ($role,$where)=split(/\./,$ENV{'request.role'});
+ if ($qualifier eq 'value') {
+ return $role;
+ } elsif ($qualifier eq 'extent') {
+ return $where;
+ }
+# ----------------------------------------------------------------- user.domain
+ } elsif ($space eq 'domain') {
+ return $ENV{'user.domain'};
+# ------------------------------------------------------------------- user.name
+ } elsif ($space eq 'name') {
+ return $ENV{'user.name'};
+# ---------------------------------------------------- Any other user namespace
} else {
+ my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
+ my %reply=&get($space,$item);
+ return $reply{$item};
+ }
+ } elsif ($realm eq 'request') {
+# ------------------------------------------------------------- request.browser
+ if ($space eq 'browser') {
+ return $ENV{'browser.'.$qualifier};
+ } elsif ($space eq 'filename') {
+ return $ENV{'request.filename'};
}
} elsif ($realm eq 'course') {
- } elsif ($realm eq 'session') {
+# ---------------------------------------------------------- course.description
+ if ($space eq 'description') {
+ my %reply=&coursedescription($ENV{'request.course.id'});
+ return $reply{'description'};
+# ------------------------------------------------------------------- course.id
+ } elsif ($space eq 'id') {
+ return $ENV{'request.course.id'};
+# -------------------------------------------------- Any other course namespace
+ } else {
+ my ($cdom,$cnam)=split(/\_/,$ENV{'request.course.id'});
+ my $chome=&homeserver($cnam,$cdom);
+ my $item=join('.',($qualifier,$rest));
+ return &unescape
+ (&reply('get:'.$cdom.':'.$cnam.':'.&escape($space).':'.
+ &escape($item),$chome));
+ }
+ } elsif ($realm eq 'userdata') {
+ my $uhome=&homeserver($qualifier,$space);
+# ----------------------------------------------- userdata.domain.name.resource
+# ---------------------------------------------------- Any other user namespace
+ } elsif ($realm eq 'environment') {
+# ----------------------------------------------------------------- environment
+ return $ENV{join('.',($space,$qualifier,$rest))};
} elsif ($realm eq 'system') {
+# ----------------------------------------------------------------- system.time
+ if ($space eq 'time') {
+ return time;
+ }
}
- return $value;
+ return '';
}
# ------------------------------------------------- Update symbolic store links
@@ -1144,11 +1245,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 {