--- loncom/lonnet/perl/lonnet.pm 2001/07/26 20:44:42 1.132
+++ loncom/lonnet/perl/lonnet.pm 2001/07/27 20:17:14 1.134
@@ -40,22 +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
+#
+#
+# for the next 6 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
-# if supplied uses udom as the domain and uname
-# as the username for the dump (supply a courseid
-# for the uname if you want a course database)
-# if not supplied it uses %ENV to get the values
-# del(namesp,array) : deletes keys out of array from namesp
-# put(namesp,hash) : stores hash in namesp
-# cput(namesp,hash) : critical put
# dump(namesp,udom,uname) : dumps the complete namespace into a hash
-# if supplied uses udom as the domain and uname
-# as the username for the dump (supply a courseid
-# for the uname if you want a course database)
-# if not supplied it uses %ENV to get the values
+# del(namesp,array,udom,uname) : deletes keys out of array from namesp
+# put(namesp,hash,udom,uname) : stores hash in namesp
+# cput(namesp,hash,udom,uname) : critical put
+#
+#
# ssi(url,hash) : does a complete request cycle on url to localhost, posts
# hash
# coursedescription(id) : returns and caches course description for id
@@ -678,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);
- }
+ }
}
}
@@ -932,7 +933,7 @@ sub get {
if (!$uname) { $uname=$ENV{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
- my $rep=reply("get:$udomain:$uname:$namespace:$items",$uhome);
+ my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
my $i=0;
@@ -946,14 +947,17 @@ sub get {
# --------------------------------------------------------------- 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
@@ -976,48 +980,53 @@ sub dump {
# --------------------------------------------------------------- put interface
sub put {
- my ($namespace,%storehash)=@_;
+ my ($namespace,$storehash,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
my $items='';
map {
- $items.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
+ } keys %$storehash;
$items=~s/\&$//;
- return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
}
# ------------------------------------------------------ critical put interface
sub cput {
- my ($namespace,%storehash)=@_;
+ my ($namespace,$storehash,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+ if (!$uname) { $uname=$ENV{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
my $items='';
map {
- $items.=escape($_).'='.escape($storehash{$_}).'&';
- } keys %storehash;
+ $items.=escape($_).'='.escape($$storehash{$_}).'&';
+ } keys %$storehash;
$items=~s/\&$//;
- return critical
- ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
- $ENV{'user.home'});
+ return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
}
# -------------------------------------------------------------- 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;
}
@@ -1426,27 +1435,20 @@ sub modifyuser {
}
}
# -------------------------------------------------------------- Add names, etc
- my $names=&reply('get:'.$udom.':'.$uname.
- ':environment:firstname&middlename&lastname&generation',
- $uhome);
- my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names);
- if ($first) { $efirst = &escape($first); }
- if ($middle) { $emiddle = &escape($middle); }
- if ($last) { $elast = &escape($last); }
- if ($gene) { $egene = &escape($gene); }
- my $reply=&reply('put:'.$udom.':'.$uname.
- ':environment:firstname='.$efirst.
- '&middlename='.$emiddle.
- '&lastname='.$elast.
- '&generation='.$egene,$uhome);
- if ($reply ne 'ok') {
- return 'error: '.$reply;
- }
+ my %names=&get('environment',
+ ['firstname','middlename','lastname','generation'],
+ $udom,$uname);
+ if ($first) { $names{'firstname'} = $first; }
+ if ($middle) { $names{'middlename'} = $middle; }
+ if ($last) { $names{'lastname'} = $last; }
+ if ($gene) { $names{'generation'} = $gene; }
+ my $reply = &put('environment', \%names, $udom,$uname);
+ if ($reply ne 'ok') { return 'error: '.$reply; }
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
$umode.', '.$first.', '.$middle.', '.
$last.', '.$gene.' by '.
$ENV{'user.name'}.' at '.$ENV{'user.domain'});
- return 'ok';
+ return 'ok';
}
# -------------------------------------------------------------- Modify student