--- 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/)) {