--- loncom/lonnet/perl/lonnet.pm 2010/08/17 01:38:08 1.1056.4.5 +++ loncom/lonnet/perl/lonnet.pm 2010/08/18 12:22:39 1.1056.4.7 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.4.5 2010/08/17 01:38:08 raeburn Exp $ +# $Id: lonnet.pm,v 1.1056.4.7 2010/08/18 12:22:39 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -222,7 +222,7 @@ sub get_server_loncaparev { my @ids=¤t_machine_ids(); if (grep(/^\Q$lonhost\E$/,@ids)) { $answer = $perlvar{'lonVersion'}; - if ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) { + if ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) { $loncaparev = $1; } } else { @@ -238,14 +238,14 @@ sub get_server_loncaparev { my $response=$ua->request($request); unless ($response->is_error()) { my $content = $response->content; - if ($content =~ /
VERSION\:\s*([\d.\-]+)<\/p>/) { + if ($content =~ /
VERSION\:\s*([\w.\-]+)<\/p>/) { $loncaparev = $1; } } } else { $loncaparev = $loncaparevs{$lonhost}; } - } elsif ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) { + } elsif ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) { $loncaparev = $1; } } @@ -4306,7 +4306,6 @@ sub role_status { my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, $env{'user.name'}); my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2); - (undef,my $group_privs) = split(/\//,$trole); $group_privs = &unescape($group_privs); &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart); @@ -6776,7 +6775,6 @@ sub modifyuser { if ($uhome eq 'no_host') { $newuser = 1; } - # ----------------------------------------------------------------- Create User if (($uhome eq 'no_host') && (($umode && $upass) || ($umode eq 'localauth'))) { @@ -6836,6 +6834,7 @@ sub modifyuser { %names = @tmp; %oldnames = %names; } +# # 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 # unless field is in $candelete array ref. @@ -6887,10 +6886,6 @@ 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.', '. $umode.', '.$first.', '.$middle.', '. $last.', '.$gene.', '.$email.', '.$inststatus; @@ -8593,7 +8588,6 @@ sub metadata { } } } else { - if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } @@ -9943,6 +9937,7 @@ sub get_dns { my %libserv; my $loaded; my %name_to_host; + my %internetdom; sub parse_hosts_tab { my ($file) = @_; @@ -9950,7 +9945,7 @@ sub get_dns { next if ($configline =~ /^(\#|\s*$ )/x); next if ($configline =~ /^\^/); chomp($configline); - my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline); + my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); $name=~s/\s//g; if ($id && $domain && $role && $name) { $hostname{$id}=$name; @@ -9966,6 +9961,9 @@ sub get_dns { } else { $protocol{$id} = 'http'; } + if (defined($intdom)) { + $internetdom{$id} = $intdom; + } } } } @@ -10082,7 +10080,6 @@ sub get_dns { my ($lonid) = @_; return $internetdom{$lonid}; } - } {