--- loncom/lonnet/perl/lonnet.pm 2001/05/30 21:53:17 1.127
+++ loncom/lonnet/perl/lonnet.pm 2001/07/26 21:40:27 1.133
@@ -40,12 +40,27 @@
# : returns hash for this symb, all args are optional
# if they aren't given they will be derived from the
# current enviroment
-# 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
+#
+#
+# for the next 4 functions udom and uname are optional
+# if supplied they use udom as the domain and uname
+# as the username for the function (supply a courseid
+# for the uname if you want a course database)
+# if not supplied it uses %ENV and looks at
+# user. attribute for the values
+#
+# eget(namesp,arrayref,udom,uname)
+# : returns hash with keys from array reference filled
+# in from namesp (encrypts the return communication)
+# get(namesp,arrayref,udom,uname)
+# : returns hash with keys from array reference filled
+# in from namesp
+# dump(namesp,udom,uname) : dumps the complete namespace into a hash
+# del(namesp,array,udom,uname) : 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
# coursedescription(id) : returns and caches course description for id
@@ -105,7 +120,9 @@
# 3/22,3/27,4/2,4/16,4/17 Scott Harrison
# 5/26,5/28 Gerd Kortemeyer
# 5/30 H. K. Ng
+# 6/1 Gerd Kortemeyer
#
+
package Apache::lonnet;
use strict;
@@ -666,22 +683,18 @@ sub devalidate {
if ($cid) {
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
my $status=
- &reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'.
- $ENV{'course.'.$cid.'.num'}.
- ':nohist_calculatedsheets:'.
- &escape($key.'studentcalc:'),
- $ENV{'course.'.$cid.'.home'})
- .' '.
- &reply('del:'.$ENV{'user.domain'}.':'.
- $ENV{'user.name'}.
- ':nohist_calculatedsheets_'.$cid.':'.
- &escape($key.'assesscalc:'.$symb),
- $ENV{'user.home'});
+ &del('nohist_calculatedsheet',
+ [$key.'studentcalc'],
+ $ENV{'course.'.$cid.'.domain'},
+ $ENV{'course.'.$cid.'.num'})
+ .' '.
+ &del('nohist_calculatedsheets_'.$cid,
+ [$key.'assesscalc:'.$symb]);
unless ($status eq 'ok ok') {
&logthis('Could not devalidate spreadsheet '.
$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
$symb.': '.$status);
- }
+ }
}
}
@@ -782,22 +795,18 @@ sub coursedescription {
$courseid=~s/^\///;
$courseid=~s/\_/\//g;
my ($cdomain,$cnum)=split(/\//,$courseid);
- my $chome=homeserver($cnum,$cdomain);
+ my $chome=&homeserver($cnum,$cdomain);
if ($chome ne 'no_host') {
- my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
- if ($rep ne 'con_lost') {
+ my %returnhash=&dump('environment',$cdomain,$cnum);
+ if (!exists($returnhash{'con_lost'})) {
my $normalid=$cdomain.'_'.$cnum;
my %envhash=();
- my %returnhash=('home' => $chome,
- 'domain' => $cdomain,
- 'num' => $cnum);
- map {
- my ($name,$value)=split(/\=/,$_);
- $name=&unescape($name);
- $value=&unescape($value);
- $returnhash{$name}=$value;
+ $returnhash{'home'}= $chome;
+ $returnhash{'domain'} = $cdomain;
+ $returnhash{'num'} = $cnum;
+ while (my ($name,$value) = each %returnhash) {
$envhash{'course.'.$normalid.'.'.$name}=$value;
- } split(/\&/,$rep);
+ }
$returnhash{'url'}='/res/'.declutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
@@ -883,9 +892,11 @@ sub rolesinit {
}
} split(/&/,$rolesdump);
my $adv=0;
+ my $author=0;
map {
%thesepriv=();
- if ($_ ne 'st') { $adv=1; }
+ if ($_!~/^st/) { $adv=1; }
+ if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
map {
if ($_ ne '') {
my ($privilege,$restrictions)=split(/&/,$_);
@@ -902,7 +913,8 @@ sub rolesinit {
map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
$userroles.='user.priv.'.$_.'='.$thesestr."\n";
} keys %allroles;
- $userroles.='user.adv='.$adv."\n";
+ $userroles.='user.adv='.$adv."\n".
+ 'user.author='.$author."\n";
$ENV{'user.adv'}=$adv;
}
return $userroles;
@@ -911,43 +923,51 @@ sub rolesinit {
# --------------------------------------------------------------- get interface
sub get {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+
+ my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
my $i=0;
map {
$returnhash{$_}=unescape($pairs[$i]);
$i++;
- } @storearr;
+ } @$storearr;
return %returnhash;
}
# --------------------------------------------------------------- del interface
sub del {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+
+ return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
}
# -------------------------------------------------------------- dump interface
sub dump {
- my $namespace=shift;
- my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",
- $ENV{'user.home'});
+ my ($namespace,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
map {
@@ -987,21 +1007,23 @@ sub cput {
# -------------------------------------------------------------- eget interface
sub eget {
- my ($namespace,@storearr)=@_;
+ my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';
map {
$items.=escape($_).'&';
- } @storearr;
+ } @$storearr;
$items=~s/\&$//;
- my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $rep=&reply("eget:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
my $i=0;
map {
$returnhash{$_}=unescape($pairs[$i]);
$i++;
- } @storearr;
+ } @$storearr;
return %returnhash;
}
@@ -1699,7 +1721,7 @@ sub EXT {
# ---------------------------------------------------- Any other user namespace
} else {
my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
- my %reply=&get($space,$item);
+ my %reply=&get($space,[$item]);
return $reply{$item};
}
} elsif ($realm eq 'request') {
@@ -1742,7 +1764,7 @@ sub EXT {
# ----------------------------------------------------------- first, check user
my %resourcedata=get('resourcedata',
- ($courselevelr,$courselevelm,$courselevel));
+ [$courselevelr,$courselevelm,$courselevel]);
if (($resourcedata{$courselevelr}!~/^error\:/) &&
($resourcedata{$courselevelr}!~/^con_lost/)) {