Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.403 and 1.407

version 1.403, 2003/08/20 01:13:56 version 1.407, 2003/08/29 20:38:12
Line 245  sub critical { Line 245  sub critical {
     }      }
     return $answer;      return $answer;
 }  }
   
   # -------------- Remove all key from the env that start witha lowercase letter
   #                (Which is alweways a lon-capa value)
   sub cleanenv {
       foreach my $key (keys(%ENV)) {
    if ($key =~ /^[a-z]/) {
       delete($ENV{$key});
    }
       }
   }
     
 # ------------------------------------------- Transfer profile into environment  # ------------------------------------------- Transfer profile into environment
   
Line 379  sub userload { Line 389  sub userload {
  my $curtime=time;   my $curtime=time;
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      if ($filename eq '.' || $filename eq '..') {next;}
     my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];      my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
     if ($curtime-$atime < 3600) { $numusers++; }      if ($curtime-$mtime < 3600) { $numusers++; }
  }   }
  closedir(LONIDS);   closedir(LONIDS);
     }      }
Line 2126  sub dump { Line 2136  sub dump {
    return %returnhash;     return %returnhash;
 }  }
   
   # -------------------------------------------------------------- keys interface
   
   sub getkeys {
      my ($namespace,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$ENV{'user.domain'}; }
      if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
      my $rep=reply("keys:$udomain:$uname:$namespace",$uhome);
      my @keyarray=();
      foreach (split(/\&/,$rep)) {
         push (@keyarray,&unescape($_));
      }
      return @keyarray;
   }
   
 # --------------------------------------------------------------- currentdump  # --------------------------------------------------------------- currentdump
 sub currentdump {  sub currentdump {
    my ($courseid,$sdom,$sname)=@_;     my ($courseid,$sdom,$sname)=@_;
Line 2799  sub modifyuser { Line 2824  sub modifyuser {
              ' in domain '.$ENV{'request.role.domain'});               ' in domain '.$ENV{'request.role.domain'});
     my $uhome=&homeserver($uname,$udom,'true');      my $uhome=&homeserver($uname,$udom,'true');
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {      if (($uhome eq 'no_host') && 
    (($umode && $upass) || ($umode eq 'localauth'))) {
         my $unhome='';          my $unhome='';
         if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) {           if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { 
             $unhome = $desiredhome;              $unhome = $desiredhome;

Removed from v.1.403  
changed lines
  Added in v.1.407


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