--- loncom/lonnet/perl/lonnet.pm 2001/07/26 21:40:27 1.133 +++ loncom/lonnet/perl/lonnet.pm 2001/07/27 20:17:14 1.134 @@ -42,7 +42,7 @@ # current enviroment # # -# for the next 4 functions udom and uname are optional +# 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) @@ -57,10 +57,10 @@ # 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,udom,uname) : stores hash in namesp +# cput(namesp,hash,udom,uname) : critical put # # -# put(namesp,hash) : stores hash in namesp -# cput(namesp,hash) : 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 @@ -980,28 +980,31 @@ 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 @@ -1432,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