[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.46 and 1.49

version 1.46, 2000/10/16 09:42:50 version 1.49, 2000/10/25 20:52:31
Line 25 Line 25
 # 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
 # store(hash)        : stores hash permanently for this url  # store(hash)        : stores hash permanently for this url
   # cstore(hash)       : critical store
 # restore            : returns hash for this url  # restore            : returns hash for this url
 # 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
 # put(namesp,hash)   : stores hash in namesp  # put(namesp,hash)   : stores hash in namesp
   # cput(namesp,hash)  : critical put
 # dump(namesp)       : dumps the complete namespace into a hash  # dump(namesp)       : dumps the complete namespace into a hash
 # 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
Line 49 Line 51
 # filelocation(dir,file) : returns a farily clean absolute reference to file   # filelocation(dir,file) : returns a farily 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
 #  #
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,  # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
 # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,  # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
Line 63 Line 66
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer  # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
 # 10/04 Gerd Kortemeyer  # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli  # 10/04 Guy Albertelli
 # 10/06,10/09,10/10,10/11,10/14 Gerd Kortemeyer  # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 424  sub ssi { Line 427  sub ssi {
   
 sub log {  sub log {
     my ($dom,$nam,$hom,$what)=@_;      my ($dom,$nam,$hom,$what)=@_;
     return reply("log:$dom:$nam:$what",$hom);      return critical("log:$dom:$nam:$what",$hom);
 }  }
   
 # ----------------------------------------------------------------------- Store  # ----------------------------------------------------------------------- Store
Line 445  sub store { Line 448  sub store {
  "$ENV{'user.home'}");   "$ENV{'user.home'}");
 }  }
   
   # -------------------------------------------------------------- Critical Store
   
   sub cstore {
       my %storehash=@_;
       my $symb;
       unless ($symb=escape(&symbread())) { return ''; }
       my $namespace;
       unless ($namespace=$ENV{'request.course.id'}) { return ''; }
       my $namevalue='';
       map {
           $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
       } keys %storehash;
       $namevalue=~s/\&$//;
       return critical(
        "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
    "$ENV{'user.home'}");
   }
   
 # --------------------------------------------------------------------- Restore  # --------------------------------------------------------------------- Restore
   
 sub restore {  sub restore {
Line 471  sub restore { Line 492  sub restore {
 sub coursedescription {  sub coursedescription {
     my $courseid=shift;      my $courseid=shift;
     $courseid=~s/^\///;      $courseid=~s/^\///;
       $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') {
Line 646  sub put { Line 668  sub put {
                  $ENV{'user.home'});                   $ENV{'user.home'});
 }  }
   
   # ------------------------------------------------------ critical put interface
   
   sub cput {
      my ($namespace,%storehash)=@_;
      my $items='';
      map {
          $items.=escape($_).'='.escape($storehash{$_}).'&';
      } keys %storehash;
      $items=~s/\&$//;
      return critical
              ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                    $ENV{'user.home'});
   }
   
 # -------------------------------------------------------------- eget interface  # -------------------------------------------------------------- eget interface
   
 sub eget {  sub eget {
Line 991  sub condval { Line 1027  sub condval {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub varval {  sub varval {
     my ($realm,$space,@components)=split(/\./,shift);      my $varname=shift;
     my $value='';      my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
       my $rest;
       if ($therest[0]) {
          $rest=join('.',@therest);
       } else {
          $rest='';
       }
     if ($realm eq 'user') {      if ($realm eq 'user') {
  if ($space=~/^resource/) {  # --------------------------------------------------------------- user.resource
     $space=~s/^resource\[//;   if ($space eq 'resource') {
             $space=~s/\]$//;  # ----------------------------------------------------------------- user.access
           } elsif ($space eq 'access') {
               return &allowed($qualifier,$rest);
   # ------------------------------------------ user.preferences, user.environment
           } elsif (($space eq 'preferences') || ($space eq 'environment')) {
               return $ENV{join('.',('environment',$qualifier,$rest))};
   # ----------------------------------------------------------------- user.course
           } elsif ($space eq 'course') {
               return $ENV{join('.',('request.course',$qualifier))};
   # ------------------------------------------------------------------- user.role
           } elsif ($space eq 'role') {
               my ($role,$where)=split(/\./,$ENV{'request.role'});
               if ($qualifier eq 'value') {
    return $role;
               } elsif ($qualifier eq 'extent') {
                   return $where;
               }
   # ----------------------------------------------------------------- user.domain
           } elsif ($space eq 'domain') {
               return $ENV{'user.domain'};
   # ------------------------------------------------------------------- user.name
           } elsif ($space eq 'name') {
               return $ENV{'user.name'};
   # ---------------------------------------------------- Any other user namespace
         } else {          } else {
               my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
               my %reply=&get($space,$item);
               return $reply{$item};
           }
       } elsif ($realm eq 'request') {
   # ------------------------------------------------------------- request.browser
           if ($space eq 'browser') {
       return $ENV{'browser.'.$qualifier};
           } elsif ($space eq 'filename') {
               return $ENV{'request.filename'};
         }          }
     } elsif ($realm eq 'course') {      } elsif ($realm eq 'course') {
     } elsif ($realm eq 'session') {  # ---------------------------------------------------------- course.description
           if ($space eq 'description') {
               my %reply=&coursedescription($ENV{'request.course.id'});
               return $reply{'description'};
   # ------------------------------------------------------------------- course.id
           } elsif ($space eq 'id') {
               return $ENV{'request.course.id'};
   # -------------------------------------------------- Any other course namespace
           } else {
       my ($cdom,$cnam)=split(/\_/,$ENV{'request.course.id'});
       my $chome=&homeserver($cnam,$cdom);
               my $item=join('.',($qualifier,$rest));
               return &unescape
                      (&reply('get:'.$cdom.':'.$cnam.':'.&escape($space).':'.
      &escape($item),$chome));
           }
       } elsif ($realm eq 'userdata') {
           my $uhome=&homeserver($qualifier,$space);
   # ----------------------------------------------- userdata.domain.name.resource
   # ---------------------------------------------------- Any other user namespace
       } elsif ($realm eq 'environment') {
   # ----------------------------------------------------------------- environment
           return $ENV{join('.',($space,$qualifier,$rest))};
     } elsif ($realm eq 'system') {      } elsif ($realm eq 'system') {
   # ----------------------------------------------------------------- system.time
    if ($space eq 'time') {
       return time;
           }
     }      }
     return $value;      return '';
 }  }
   
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
Removed from v.1.46  
changed lines
  Added in v.1.49

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