Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.133 and 1.134

version 1.133, 2001/07/26 21:40:27 version 1.134, 2001/07/27 20:17:14
Line 42 Line 42
 #                      current enviroment  #                      current enviroment
 #  #
 #  #
 # for the next 4 functions udom and uname are optional  # for the next 6 functions udom and uname are optional
 #         if supplied they use udom as the domain and uname  #         if supplied they use udom as the domain and uname
 #         as the username for the function (supply a courseid  #         as the username for the function (supply a courseid
 #         for the uname if you want a course database)  #         for the uname if you want a course database)
Line 57 Line 57
 #                      in from namesp  #                      in from namesp
 # dump(namesp,udom,uname) : dumps the complete namespace into a hash  # dump(namesp,udom,uname) : dumps the complete namespace into a hash
 # del(namesp,array,udom,uname)  : deletes keys out of array from namesp  # del(namesp,array,udom,uname)  : deletes keys out of array from namesp
   # put(namesp,hash,udom,uname)   : stores hash in namesp
   # cput(namesp,hash,udom,uname)  : critical put
 #  #
 #  #
 # put(namesp,hash)   : stores hash in namesp  
 # cput(namesp,hash)  : critical put  
 # 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 980  sub dump { Line 980  sub dump {
 # --------------------------------------------------------------- put interface  # --------------------------------------------------------------- put interface
   
 sub put {  sub put {
    my ($namespace,%storehash)=@_;     my ($namespace,$storehash,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$ENV{'user.domain'}; }
      if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    map {     map {
        $items.=escape($_).'='.escape($storehash{$_}).'&';         $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
    } keys %storehash;     } keys %$storehash;
    $items=~s/\&$//;     $items=~s/\&$//;
    return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
                  $ENV{'user.home'});  
 }  }
   
 # ------------------------------------------------------ critical put interface  # ------------------------------------------------------ critical put interface
   
 sub cput {  sub cput {
    my ($namespace,%storehash)=@_;     my ($namespace,$storehash,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$ENV{'user.domain'}; }
      if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    map {     map {
        $items.=escape($_).'='.escape($storehash{$_}).'&';         $items.=escape($_).'='.escape($$storehash{$_}).'&';
    } keys %storehash;     } keys %$storehash;
    $items=~s/\&$//;     $items=~s/\&$//;
    return critical     return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
            ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",  
                  $ENV{'user.home'});  
 }  }
   
 # -------------------------------------------------------------- eget interface  # -------------------------------------------------------------- eget interface
Line 1432  sub modifyuser { Line 1435  sub modifyuser {
        }         }
     }      }
 # -------------------------------------------------------------- Add names, etc  # -------------------------------------------------------------- Add names, etc
     my $names=&reply('get:'.$udom.':'.$uname.      my %names=&get('environment',
                      ':environment:firstname&middlename&lastname&generation',     ['firstname','middlename','lastname','generation'],
                      $uhome);     $udom,$uname);
     my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names);      if ($first)  { $names{'firstname'}  = $first; }
     if ($first)  { $efirst  = &escape($first); }      if ($middle) { $names{'middlename'} = $middle; }
     if ($middle) { $emiddle = &escape($middle); }      if ($last)   { $names{'lastname'}   = $last; }
     if ($last)   { $elast   = &escape($last); }      if ($gene)   { $names{'generation'} = $gene; }
     if ($gene)   { $egene   = &escape($gene); }      my $reply = &put('environment', \%names, $udom,$uname);
     my $reply=&reply('put:'.$udom.':'.$uname.      if ($reply ne 'ok') { return 'error: '.$reply; }
            ':environment:firstname='.$efirst.  
                       '&middlename='.$emiddle.  
                         '&lastname='.$elast.  
                       '&generation='.$egene,$uhome);  
     if ($reply ne 'ok') {  
  return 'error: '.$reply;  
     }  
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
      $last.', '.$gene.' by '.       $last.', '.$gene.' by '.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});               $ENV{'user.name'}.' at '.$ENV{'user.domain'});
     return 'ok';       return 'ok';
 }  }
   
 # -------------------------------------------------------------- Modify student  # -------------------------------------------------------------- Modify student

Removed from v.1.133  
changed lines
  Added in v.1.134


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