[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.120 and 1.128

version 1.120, 2001/04/02 16:56:22 version 1.128, 2001/06/01 19:32:40
Line 28 Line 28
 # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role  # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
 # appenv(hash)       : adds hash to session environment  # appenv(hash)       : adds hash to session environment
 # delenv(varname)    : deletes all environment entries starting with varname  # delenv(varname)    : deletes all environment entries starting with varname
 # store(hash)        : stores hash permanently for this url  # store(hashref,symb,courseid,udom,uname)
 # cstore(hash)       : critical store  #                    : stores hash permanently for this url
 # restore            : returns hash 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)
   #                    : same as store but uses the critical interface to 
   #                      guarentee a store
   # 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
 # 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,array)  : returns hash with keys from array filled in from namesp
 # del(namesp,array)  : deletes keys out of array from namesp  # del(namesp,array)  : deletes keys out of array from namesp
Line 52 Line 61
 # receipt()          : returns a receipt to be given out to users   # receipt()          : returns a receipt to be given out to users 
 # getfile(filename)  : returns the contents of filename, or a -1 if it can't  # getfile(filename)  : returns the contents of filename, or a -1 if it can't
 #                      be found, replicates and subscribes to the file  #                      be found, replicates and subscribes to the file
 # filelocation(dir,file) : returns a farily clean absolute reference to file   # filelocation(dir,file) : returns a fairly clean absolute reference to file 
 #                          from the directory dir  #                          from the directory dir
 # hreflocation(dir,file) : same as filelocation, but for hrefs  # hreflocation(dir,file) : same as filelocation, but for hrefs
 # log(domain,user,home,msg) : write to permanent log for user  # log(domain,user,home,msg) : write to permanent log for user
Line 93 Line 102
 # 3/2 Gerd Kortemeyer  # 3/2 Gerd Kortemeyer
 # 3/15,3/19 Scott Harrison  # 3/15,3/19 Scott Harrison
 # 3/19,3/20 Gerd Kortemeyer  # 3/19,3/20 Gerd Kortemeyer
 # 3/22,3/27 Scott Harrison  # 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;  package Apache::lonnet;
   
Line 677  sub devalidate { Line 690  sub devalidate {
 # ----------------------------------------------------------------------- Store  # ----------------------------------------------------------------------- Store
   
 sub store {  sub store {
     my %storehash=@_;      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $symb;      my $home='';
     unless ($symb=&symbread()) { return ''; }  
       if ($stuname) {
    $home=&homeserver($stuname,$domain);
       }
   
       if (!$symb) { unless ($symb=&symbread()) { return ''; } }
   
     &devalidate($symb);      &devalidate($symb);
   
     $symb=escape($symb);      $symb=escape($symb);
     my $namespace;      if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
     unless ($namespace=$ENV{'request.course.id'}) { return ''; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
       if (!$stuname) { $stuname=$ENV{'user.name'}; }
       if (!$home) { $home=$ENV{'user.home'}; }
     my $namevalue='';      my $namevalue='';
     map {      map {
         $namevalue.=escape($_).'='.escape($storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     } keys %storehash;      } keys %$storehash;
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     return reply(      return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
      "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",  
  "$ENV{'user.home'}");  
 }  }
   
 # -------------------------------------------------------------- Critical Store  # -------------------------------------------------------------- Critical Store
   
 sub cstore {  sub cstore {
     my %storehash=@_;      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $symb;      my $home='';
     unless ($symb=&symbread()) { return ''; }  
       if ($stuname) {
    $home=&homeserver($stuname,$domain);
       }
   
       if (!$symb) { unless ($symb=&symbread()) { return ''; } }
   
     &devalidate($symb);      &devalidate($symb);
   
     $symb=escape($symb);      $symb=escape($symb);
     my $namespace;      if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
     unless ($namespace=$ENV{'request.course.id'}) { return ''; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
       if (!$stuname) { $stuname=$ENV{'user.name'}; }
       if (!$home) { $home=$ENV{'user.home'}; }
   
     my $namevalue='';      my $namevalue='';
     map {      map {
         $namevalue.=escape($_).'='.escape($storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     } keys %storehash;      } keys %$storehash;
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     return critical(      return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
      "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",  
  "$ENV{'user.home'}");  
 }  }
   
 # --------------------------------------------------------------------- Restore  # --------------------------------------------------------------------- Restore
   
 sub restore {  sub restore {
     my $symb;      my ($symb,$namespace,$domain,$stuname) = @_;
     unless ($symb=escape(&symbread())) { return ''; }      my $home='';
     my $namespace;  
     unless ($namespace=$ENV{'request.course.id'}) { return ''; }      if ($stuname) {
     my $answer=reply(   $home=&homeserver($stuname,$domain);
               "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb",      }
               "$ENV{'user.home'}");  
       if (!$symb) {
         unless ($symb=escape(&symbread())) { return ''; }
       } else {
         $symb=&escape($symb);
       }
       if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
       if (!$domain) { $domain=$ENV{'user.domain'}; }
       if (!$stuname) { $stuname=$ENV{'user.name'}; }
       if (!$home) { $home=$ENV{'user.home'}; }
       my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
   
     my %returnhash=();      my %returnhash=();
     map {      map {
  my ($name,$value)=split(/\=/,$_);   my ($name,$value)=split(/\=/,$_);
Line 849  sub rolesinit { Line 884  sub rolesinit {
             }              }
           }             } 
         } split(/&/,$rolesdump);          } split(/&/,$rolesdump);
           my $adv=0;
           my $author=0;
         map {          map {
             %thesepriv=();              %thesepriv=();
               if ($_!~/^st/) { $adv=1; }
               if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             map {              map {
                 if ($_ ne '') {                  if ($_ ne '') {
     my ($privilege,$restrictions)=split(/&/,$_);      my ($privilege,$restrictions)=split(/&/,$_);
Line 867  sub rolesinit { Line 906  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".
               'user.author='.$author."\n";
           $ENV{'user.adv'}=$adv;
     }      }
     return $userroles;        return $userroles;  
 }  }
Line 1246  sub metadata_query { Line 1288  sub metadata_query {
     my ($query,$custom,$customshow)=@_;      my ($query,$custom,$customshow)=@_;
     # need to put in a library server loop here and return a hash      # need to put in a library server loop here and return a hash
     my %rhash;      my %rhash;
 #    for my $server (keys %libserv) {      for my $server (keys %libserv) {
     for my $server ('msul3') {  
  unless ($custom or $customshow) {   unless ($custom or $customshow) {
     my $reply=&reply("querysend:".&escape($query),$server);      my $reply=&reply("querysend:".&escape($query),$server);
     $rhash{$server}=$reply;      $rhash{$server}=$reply;
Line 1635  sub EXT { Line 1676  sub EXT {
     if ($realm eq 'user') {      if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource  # --------------------------------------------------------------- user.resource
  if ($space eq 'resource') {   if ($space eq 'resource') {
     my %restored=&restore;      my %restored=&restore();
             return $restored{$qualifierrest};              return $restored{$qualifierrest};
 # ----------------------------------------------------------------- user.access  # ----------------------------------------------------------------- user.access
         } elsif ($space eq 'access') {          } elsif ($space eq 'access') {
Line 1676  sub EXT { Line 1717  sub EXT {
         }          }
     } elsif ($realm eq 'course') {      } elsif ($realm eq 'course') {
 # ---------------------------------------------------------- course.description  # ---------------------------------------------------------- course.description
         my $section='';          return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
         if ($ENV{'request.course.sec'}) {  
     $section='_'.$ENV{'request.course.sec'};  
         }  
         return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.  
                               $spacequalifierrest};                                $spacequalifierrest};
     } elsif ($realm eq 'resource') {      } elsif ($realm eq 'resource') {
       if ($ENV{'request.course.id'}) {         if ($ENV{'request.course.id'}) {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
        my $symbp=&symbread();           my $symbp=&symbread();
        my $mapp=(split(/\_\_\_/,$symbp))[0];           my $mapp=(split(/\_\_\_/,$symbp))[0];
   
        my $symbparm=$symbp.'.'.$spacequalifierrest;           my $symbparm=$symbp.'.'.$spacequalifierrest;
        my $mapparm=$mapp.'___(all).'.$spacequalifierrest;           my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
   
        my $seclevel=           my $seclevel=
             $ENV{'request.course.id'}.'.['.              $ENV{'request.course.id'}.'.['.
  $ENV{'request.course.sec'}.'].'.$spacequalifierrest;   $ENV{'request.course.sec'}.'].'.$spacequalifierrest;
        my $seclevelr=           my $seclevelr=
             $ENV{'request.course.id'}.'.['.              $ENV{'request.course.id'}.'.['.
  $ENV{'request.course.sec'}.'].'.$symbparm;   $ENV{'request.course.sec'}.'].'.$symbparm;
        my $seclevelm=           my $seclevelm=
             $ENV{'request.course.id'}.'.['.              $ENV{'request.course.id'}.'.['.
  $ENV{'request.course.sec'}.'].'.$mapparm;   $ENV{'request.course.sec'}.'].'.$mapparm;
   
        my $courselevel=           my $courselevel=
             $ENV{'request.course.id'}.'.'.$spacequalifierrest;              $ENV{'request.course.id'}.'.'.$spacequalifierrest;
        my $courselevelr=           my $courselevelr=
             $ENV{'request.course.id'}.'.'.$symbparm;              $ENV{'request.course.id'}.'.'.$symbparm;
        my $courselevelm=           my $courselevelm=
             $ENV{'request.course.id'}.'.'.$mapparm;              $ENV{'request.course.id'}.'.'.$mapparm;
   
 # ----------------------------------------------------------- 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/)) {
   
        if ($resourcedata{$courselevelr}) {            if ($resourcedata{$courselevelr}) { 
           return $resourcedata{$courselevelr}; }              return $resourcedata{$courselevelr}; }
        if ($resourcedata{$courselevelm}) {            if ($resourcedata{$courselevelm}) { 
           return $resourcedata{$courselevelm}; }              return $resourcedata{$courselevelm}; }
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }           if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
   
       } else {        } else {
   if ($resourcedata{$courselevelr}!~/No such file/) {    if ($resourcedata{$courselevelr}!~/No such file/) {
Line 1776  sub EXT { Line 1813  sub EXT {
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment  # ----------------------------------------------------------------- environment
         return $ENV{$spacequalifierrest};          return $ENV{'environment.'.$spacequalifierrest};
     } elsif ($realm eq 'system') {      } elsif ($realm eq 'system') {
 # ----------------------------------------------------------------- system.time  # ----------------------------------------------------------------- system.time
  if ($space eq 'time') {   if ($space eq 'time') {
Removed from v.1.120  
changed lines
  Added in v.1.128

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