Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1056.4.5 and 1.1056.4.6

version 1.1056.4.5, 2010/08/17 01:38:08 version 1.1056.4.6, 2010/08/17 01:49:04
Line 4306  sub role_status { Line 4306  sub role_status {
                                 my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},                                  my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
                                                     $env{'user.name'});                                                      $env{'user.name'});
                                 my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);                                  my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
   
                                 (undef,my $group_privs) = split(/\//,$trole);                                  (undef,my $group_privs) = split(/\//,$trole);
                                 $group_privs = &unescape($group_privs);                                  $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);                                  &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
Line 6776  sub modifyuser { Line 6775  sub modifyuser {
     if ($uhome eq 'no_host') {      if ($uhome eq 'no_host') {
         $newuser = 1;          $newuser = 1;
     }      }
   
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') &&       if (($uhome eq 'no_host') && 
  (($umode && $upass) || ($umode eq 'localauth'))) {   (($umode && $upass) || ($umode eq 'localauth'))) {
Line 6836  sub modifyuser { Line 6834  sub modifyuser {
         %names = @tmp;          %names = @tmp;
         %oldnames = %names;          %oldnames = %names;
     }      }
   #
 # If name, email and/or uid are blank (e.g., because an uploaded file  # If name, email and/or uid are blank (e.g., because an uploaded file
 # of users did not contain them), do not overwrite existing values  # of users did not contain them), do not overwrite existing values
 # unless field is in $candelete array ref.    # unless field is in $candelete array ref.  
Line 6887  sub modifyuser { Line 6886  sub modifyuser {
             }              }
         }          }
     }      }
     my $reply = &put('environment', \%names, $udom,$uname);  
     if ($reply ne 'ok') { return 'error: '.$reply; }  
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);  
     &devalidate_cache_new('namescache',$uname.':'.$udom);  
     my $logmsg = $udom.', '.$uname.', '.$uid.', '.      my $logmsg = $udom.', '.$uname.', '.$uid.', '.
                  $umode.', '.$first.', '.$middle.', '.                   $umode.', '.$first.', '.$middle.', '.
                  $last.', '.$gene.', '.$email.', '.$inststatus;                   $last.', '.$gene.', '.$email.', '.$inststatus;
Line 8593  sub metadata { Line 8588  sub metadata {
     }      }
  }   }
     } else {       } else { 
   
  if (defined($token->[2]->{'name'})) {    if (defined($token->[2]->{'name'})) { 
     $unikey.='_'.$token->[2]->{'name'};       $unikey.='_'.$token->[2]->{'name'}; 
  }   }
Line 9943  sub get_dns { Line 9937  sub get_dns {
     my %libserv;      my %libserv;
     my $loaded;      my $loaded;
     my %name_to_host;      my %name_to_host;
       my %internetdom;
   
     sub parse_hosts_tab {      sub parse_hosts_tab {
  my ($file) = @_;   my ($file) = @_;
Line 9950  sub get_dns { Line 9945  sub get_dns {
     next if ($configline =~ /^(\#|\s*$ )/x);      next if ($configline =~ /^(\#|\s*$ )/x);
     next if ($configline =~ /^\^/);      next if ($configline =~ /^\^/);
     chomp($configline);      chomp($configline);
     my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline);      my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     if ($id && $domain && $role && $name) {      if ($id && $domain && $role && $name) {
  $hostname{$id}=$name;   $hostname{$id}=$name;
Line 9966  sub get_dns { Line 9961  sub get_dns {
                 } else {                  } else {
                     $protocol{$id} = 'http';                      $protocol{$id} = 'http';
                 }                  }
                   if (defined($intdom)) {
                       $internetdom{$id} = $intdom;
                   }
     }      }
  }   }
     }      }
Line 10082  sub get_dns { Line 10080  sub get_dns {
         my ($lonid) = @_;          my ($lonid) = @_;
         return $internetdom{$lonid};          return $internetdom{$lonid};
     }      }
   
 }  }
   
 {   { 

Removed from v.1.1056.4.5  
changed lines
  Added in v.1.1056.4.6


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