[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.127 and 1.132

version 1.127, 2001/05/30 21:53:17 version 1.132, 2001/07/26 20:44:42
Line 41 Line 41
 #                      if they aren't given they will be derived from the   #                      if they aren't given they will be derived from the 
 #                      current enviroment  #                      current enviroment
 # eget(namesp,array) : returns hash with keys from array filled in from namesp  # 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  # del(namesp,array)  : deletes keys out of array from namesp
 # put(namesp,hash)   : stores hash in namesp  # put(namesp,hash)   : stores hash in namesp
 # cput(namesp,hash)  : critical put  # 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  # ssi(url,hash)      : does a complete request cycle on url to localhost, posts
 #                      hash  #                      hash
 # coursedescription(id) : returns and caches course description for id  # coursedescription(id) : returns and caches course description for id
Line 105 Line 115
 # 3/22,3/27,4/2,4/16,4/17 Scott Harrison  # 3/22,3/27,4/2,4/16,4/17 Scott Harrison
 # 5/26,5/28 Gerd Kortemeyer  # 5/26,5/28 Gerd Kortemeyer
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
   # 6/1 Gerd Kortemeyer
 #  #
   
 package Apache::lonnet;  package Apache::lonnet;
   
 use strict;  use strict;
Line 782  sub coursedescription { Line 794  sub coursedescription {
     $courseid=~s/^\///;      $courseid=~s/^\///;
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     my ($cdomain,$cnum)=split(/\//,$courseid);      my ($cdomain,$cnum)=split(/\//,$courseid);
     my $chome=homeserver($cnum,$cdomain);      my $chome=&homeserver($cnum,$cdomain);
     if ($chome ne 'no_host') {      if ($chome ne 'no_host') {
        my $rep=reply("dump:$cdomain:$cnum:environment",$chome);         my %returnhash=&dump('environment',$cdomain,$cnum);
        if ($rep ne 'con_lost') {         if (!exists($returnhash{'con_lost'})) {
            my $normalid=$cdomain.'_'.$cnum;             my $normalid=$cdomain.'_'.$cnum;
            my %envhash=();             my %envhash=();
            my %returnhash=('home'   => $chome,              $returnhash{'home'}= $chome;
                            'domain' => $cdomain,     $returnhash{'domain'} = $cdomain;
                            'num'    => $cnum);     $returnhash{'num'} = $cnum;
            map {             while (my ($name,$value) = each %returnhash) {
                my ($name,$value)=split(/\=/,$_);  
                $name=&unescape($name);  
                $value=&unescape($value);  
                $returnhash{$name}=$value;  
                $envhash{'course.'.$normalid.'.'.$name}=$value;                 $envhash{'course.'.$normalid.'.'.$name}=$value;
            } split(/\&/,$rep);             }
            $returnhash{'url'}='/res/'.declutter($returnhash{'url'});             $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.             $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
        $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;         $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
Line 883  sub rolesinit { Line 891  sub rolesinit {
           }             } 
         } split(/&/,$rolesdump);          } split(/&/,$rolesdump);
         my $adv=0;          my $adv=0;
           my $author=0;
         map {          map {
             %thesepriv=();              %thesepriv=();
             if ($_ ne 'st') { $adv=1; }              if ($_!~/^st/) { $adv=1; }
               if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             map {              map {
                 if ($_ ne '') {                  if ($_ ne '') {
     my ($privilege,$restrictions)=split(/&/,$_);      my ($privilege,$restrictions)=split(/&/,$_);
Line 902  sub rolesinit { Line 912  sub rolesinit {
             map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;              map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
             $userroles.='user.priv.'.$_.'='.$thesestr."\n";              $userroles.='user.priv.'.$_.'='.$thesestr."\n";
         } keys %allroles;                      } keys %allroles;            
         $userroles.='user.adv='.$adv."\n";          $userroles.='user.adv='.$adv."\n".
               'user.author='.$author."\n";
         $ENV{'user.adv'}=$adv;          $ENV{'user.adv'}=$adv;
     }      }
     return $userroles;        return $userroles;  
Line 911  sub rolesinit { Line 922  sub rolesinit {
 # --------------------------------------------------------------- get interface  # --------------------------------------------------------------- get interface
   
 sub get {  sub get {
    my ($namespace,@storearr)=@_;     my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';     my $items='';
    map {     map {
        $items.=escape($_).'&';         $items.=escape($_).'&';
    } @storearr;     } @$storearr;
    $items=~s/\&$//;     $items=~s/\&$//;
  my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
                  $ENV{'user.home'});     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 @pairs=split(/\&/,$rep);
    my %returnhash=();     my %returnhash=();
    my $i=0;     my $i=0;
    map {     map {
       $returnhash{$_}=unescape($pairs[$i]);        $returnhash{$_}=unescape($pairs[$i]);
       $i++;        $i++;
    } @storearr;     } @$storearr;
    return %returnhash;     return %returnhash;
 }  }
   
Line 945  sub del { Line 959  sub del {
 # -------------------------------------------------------------- dump interface  # -------------------------------------------------------------- dump interface
   
 sub dump {  sub dump {
    my $namespace=shift;     my ($namespace,$udomain,$uname)=@_;
    my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
                 $ENV{'user.home'});     if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
      my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);
    my @pairs=split(/\&/,$rep);     my @pairs=split(/\&/,$rep);
    my %returnhash=();     my %returnhash=();
    map {     map {
Line 1699  sub EXT { Line 1715  sub EXT {
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
         } else {          } else {
             my $item=($rest)?$qualifier.'.'.$rest:$qualifier;              my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
             my %reply=&get($space,$item);              my %reply=&get($space,[$item]);
             return $reply{$item};              return $reply{$item};
         }          }
     } elsif ($realm eq 'request') {      } elsif ($realm eq 'request') {
Line 1742  sub EXT { Line 1758  sub EXT {
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
          my %resourcedata=get('resourcedata',           my %resourcedata=get('resourcedata',
                            ($courselevelr,$courselevelm,$courselevel));                             [$courselevelr,$courselevelm,$courselevel]);
          if (($resourcedata{$courselevelr}!~/^error\:/) &&           if (($resourcedata{$courselevelr}!~/^error\:/) &&
              ($resourcedata{$courselevelr}!~/^con_lost/)) {               ($resourcedata{$courselevelr}!~/^con_lost/)) {
   
Removed from v.1.127  
changed lines
  Added in v.1.132

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>