--- loncom/lonnet/perl/lonnet.pm 2003/06/19 19:37:45 1.382 +++ loncom/lonnet/perl/lonnet.pm 2003/07/11 20:41:41 1.390 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.382 2003/06/19 19:37:45 albertel Exp $ +# $Id: lonnet.pm,v 1.390 2003/07/11 20:41:41 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2732,7 +2732,7 @@ sub modifyuser { my ($udom, $uname, $uid, $umode, $upass, $first, $middle, $last, $gene, - $forceid, $desiredhome)=@_; + $forceid, $desiredhome, $email)=@_; $udom=~s/\W//g; $uname=~s/\W//g; &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. @@ -2774,7 +2774,7 @@ sub modifyuser { } $uhome=&homeserver($uname,$udom,'true'); if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) { - return 'error: verify home'; + return 'error: unable verify users home machine.'; } } # End of creation of new user # ---------------------------------------------------------------------- Add ID @@ -2784,7 +2784,8 @@ sub modifyuser { if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/) && (!$forceid)) { unless ($uid eq $uidhash{$uname}) { - return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid; + return 'error: user id "'.$uid.'" does not match '. + 'current user id "'.$uidhash{$uname}.'".'; } } else { &idput($udom,($uname => $uid)); @@ -2800,10 +2801,17 @@ sub modifyuser { } else { %names = @tmp; } +# +# Make sure to not trash student environment if instructor does not bother +# to supply name and email information +# if ($first) { $names{'firstname'} = $first; } - if ($middle) { $names{'middlename'} = $middle; } + if (defined($middle)) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; } - if ($gene) { $names{'generation'} = $gene; } + if (defined($gene)) { $names{'generation'} = $gene; } + if ($email) { $names{'notification'} = $email; + $names{'critnotification'} = $email; } + my $reply = &put('environment', \%names, $udom,$uname); if ($reply ne 'ok') { return 'error: '.$reply; } &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. @@ -2817,7 +2825,7 @@ sub modifyuser { sub modifystudent { my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, - $end,$start,$forceid,$desiredhome)=@_; + $end,$start,$forceid,$desiredhome,$email)=@_; my $cid=''; unless ($cid=$ENV{'request.course.id'}) { return 'not_in_class'; @@ -2825,7 +2833,7 @@ sub modifystudent { # --------------------------------------------------------------- Make the user my $reply=&modifyuser ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, - $desiredhome); + $desiredhome,$email); unless ($reply eq 'ok') { return $reply; } # This will cause &modify_student_enrollment to get the uid from the # students environment @@ -3190,13 +3198,13 @@ sub courseresdata { # sub clear_EXT_cache_status { - &delenv('cache.'); + &delenv('cache.EXT.'); } sub EXT_cache_status { my ($target_domain,$target_user) = @_; - my $cachename = 'cache.'.$target_user.'.'.$target_domain; - if (exists($ENV{$cachename}) && ($ENV{$cachename}+1800) > time) { + my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; + if (exists($ENV{$cachename}) && ($ENV{$cachename}+600) > time) { # We know already the user has no data return 1; } else { @@ -3206,7 +3214,7 @@ sub EXT_cache_status { sub EXT_cache_set { my ($target_domain,$target_user) = @_; - my $cachename = 'cache.'.$target_user.'.'.$target_domain; + my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; &appenv($cachename => time); } @@ -3297,7 +3305,8 @@ sub EXT { } } elsif ($realm eq 'query') { # ---------------------------------------------- pull stuff out of query string - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + [$spacequalifierrest]); return $ENV{'form.'.$spacequalifierrest}; } elsif ($realm eq 'request') { # ------------------------------------------------------------- request.browser @@ -4091,7 +4100,8 @@ BEGIN { %domain_auth_arg_def = (); if ($fh) { while (<$fh>) { - next if /^\#/; + next if (/^(\#|\s*$)/); +# next if /^\#/; chomp; my ($domain, $domain_description, $def_auth, $def_auth_arg) = split(/:/,$_,4);