--- loncom/lonnet/perl/lonnet.pm 2001/04/17 13:53:26 1.123 +++ loncom/lonnet/perl/lonnet.pm 2001/07/26 20:44:42 1.132 @@ -28,24 +28,34 @@ # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role # appenv(hash) : adds hash to session environment # delenv(varname) : deletes all environment entries starting with varname -# store(hashref,symb,courseid,udom,uname,homeserver) +# store(hashref,symb,courseid,udom,uname) # : stores hash permanently for this url # hashref needs to be given, and should be a \%hashname # the remaining args aren't required and if they aren't # passed or are '' they will be derived from the ENV -# cstore(hashref,symb,courseid,udom,uname,homeserver) +# cstore(hashref,symb,courseid,udom,uname) # : same as store but uses the critical interface to # guarentee a store -# restore(symb,courseid,udom,uname,homeserver) +# restore(symb,courseid,udom,uname) # : returns hash for this symb, all args are optional -# if they aren't given they will be derived from the current -# enviroment +# 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 +# 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) : dumps the complete namespace into a hash +# 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 # ssi(url,hash) : does a complete request cycle on url to localhost, posts # hash # coursedescription(id) : returns and caches course description for id @@ -103,6 +113,10 @@ # 3/15,3/19 Scott Harrison # 3/19,3/20 Gerd Kortemeyer # 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; @@ -686,7 +700,13 @@ sub devalidate { # ----------------------------------------------------------------------- Store sub store { - my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my $home=''; + + if ($stuname) { + $home=&homeserver($stuname,$domain); + } + if (!$symb) { unless ($symb=&symbread()) { return ''; } } &devalidate($symb); @@ -701,13 +721,19 @@ sub store { $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; } keys %$storehash; $namevalue=~s/\&$//; - return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); } # -------------------------------------------------------------- Critical Store sub cstore { - my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my $home=''; + + if ($stuname) { + $home=&homeserver($stuname,$domain); + } + if (!$symb) { unless ($symb=&symbread()) { return ''; } } &devalidate($symb); @@ -729,7 +755,13 @@ sub cstore { # --------------------------------------------------------------------- Restore sub restore { - my ($symb,$namespace,$domain,$stuname,$home) = @_; + my ($symb,$namespace,$domain,$stuname) = @_; + my $home=''; + + if ($stuname) { + $home=&homeserver($stuname,$domain); + } + if (!$symb) { unless ($symb=escape(&symbread())) { return ''; } } else { @@ -762,22 +794,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; @@ -862,8 +890,12 @@ sub rolesinit { } } } split(/&/,$rolesdump); + my $adv=0; + my $author=0; map { %thesepriv=(); + if ($_!~/^st/) { $adv=1; } + if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; } map { if ($_ ne '') { my ($privilege,$restrictions)=split(/&/,$_); @@ -880,6 +912,9 @@ sub rolesinit { map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv; $userroles.='user.priv.'.$_.'='.$thesestr."\n"; } keys %allroles; + $userroles.='user.adv='.$adv."\n". + 'user.author='.$author."\n"; + $ENV{'user.adv'}=$adv; } return $userroles; } @@ -887,21 +922,24 @@ 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; } @@ -921,9 +959,11 @@ sub del { # -------------------------------------------------------------- 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 { @@ -1675,7 +1715,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') { @@ -1688,49 +1728,45 @@ sub EXT { } } elsif ($realm eq 'course') { # ---------------------------------------------------------- course.description - my $section=''; - if ($ENV{'request.course.sec'}) { - $section='_'.$ENV{'request.course.sec'}; - } - return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'. + return $ENV{'course.'.$ENV{'request.course.id'}.'.'. $spacequalifierrest}; } elsif ($realm eq 'resource') { - if ($ENV{'request.course.id'}) { + if ($ENV{'request.course.id'}) { # ----------------------------------------------------- Cascading lookup scheme - my $symbp=&symbread(); - my $mapp=(split(/\_\_\_/,$symbp))[0]; + my $symbp=&symbread(); + my $mapp=(split(/\_\_\_/,$symbp))[0]; - my $symbparm=$symbp.'.'.$spacequalifierrest; - my $mapparm=$mapp.'___(all).'.$spacequalifierrest; + my $symbparm=$symbp.'.'.$spacequalifierrest; + my $mapparm=$mapp.'___(all).'.$spacequalifierrest; - my $seclevel= + my $seclevel= $ENV{'request.course.id'}.'.['. $ENV{'request.course.sec'}.'].'.$spacequalifierrest; - my $seclevelr= + my $seclevelr= $ENV{'request.course.id'}.'.['. $ENV{'request.course.sec'}.'].'.$symbparm; - my $seclevelm= + my $seclevelm= $ENV{'request.course.id'}.'.['. $ENV{'request.course.sec'}.'].'.$mapparm; - my $courselevel= + my $courselevel= $ENV{'request.course.id'}.'.'.$spacequalifierrest; - my $courselevelr= + my $courselevelr= $ENV{'request.course.id'}.'.'.$symbparm; - my $courselevelm= + my $courselevelm= $ENV{'request.course.id'}.'.'.$mapparm; # ----------------------------------------------------------- first, check user - my %resourcedata=get('resourcedata', - ($courselevelr,$courselevelm,$courselevel)); - if (($resourcedata{$courselevelr}!~/^error\:/) && - ($resourcedata{$courselevelr}!~/^con_lost/)) { - - if ($resourcedata{$courselevelr}) { - return $resourcedata{$courselevelr}; } - if ($resourcedata{$courselevelm}) { - return $resourcedata{$courselevelm}; } - if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } + my %resourcedata=get('resourcedata', + [$courselevelr,$courselevelm,$courselevel]); + if (($resourcedata{$courselevelr}!~/^error\:/) && + ($resourcedata{$courselevelr}!~/^con_lost/)) { + + if ($resourcedata{$courselevelr}) { + return $resourcedata{$courselevelr}; } + if ($resourcedata{$courselevelm}) { + return $resourcedata{$courselevelm}; } + if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } } else { if ($resourcedata{$courselevelr}!~/No such file/) { @@ -1788,7 +1824,7 @@ sub EXT { # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment - return $ENV{$spacequalifierrest}; + return $ENV{'environment.'.$spacequalifierrest}; } elsif ($realm eq 'system') { # ----------------------------------------------------------------- system.time if ($space eq 'time') {