--- loncom/lonnet/perl/lonnet.pm 2002/04/10 15:28:45 1.208 +++ loncom/lonnet/perl/lonnet.pm 2002/05/06 13:46:41 1.211 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.208 2002/04/10 15:28:45 albertel Exp $ +# $Id: lonnet.pm,v 1.211 2002/05/06 13:46:41 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1877,11 +1877,11 @@ sub modifyuser { # ----------------------------------------------------------------- Create User if (($uhome eq 'no_host') && ($umode) && ($upass)) { my $unhome=''; - if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) { - $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; - } elsif (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { + if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { $unhome = $desiredhome; - } else { + } elsif($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) { + $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + } else { # load balancing routine for determining $unhome my $tryserver; my $loadm=10000000; foreach $tryserver (keys %libserv) { @@ -1907,7 +1907,7 @@ sub modifyuser { if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) { return 'error: verify home'; } - } + } # End of creation of new user # ---------------------------------------------------------------------- Add ID if ($uid) { $uid=~tr/A-Z/a-z/; @@ -1943,14 +1943,15 @@ sub modifyuser { sub modifystudent { my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, - $end,$start,$forceid)=@_; + $end,$start,$forceid,$desiredhome)=@_; my $cid=''; unless ($cid=$ENV{'request.course.id'}) { return 'not_in_class'; } # --------------------------------------------------------------- Make the user my $reply=&modifyuser - ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid); + ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, + $desiredhome); unless ($reply eq 'ok') { return $reply; } my $uhome=&homeserver($uname,$udom); if (($uhome eq '') || ($uhome eq 'no_host')) { @@ -2516,12 +2517,23 @@ sub symblist { return 'error'; } +# --------------------------------------------------------------- Clean-up symb + +sub symbclean { + my $symb=shift; +# remove version from map + $symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; +# remove version from URL + $symb=~s/\.(\d+)\.(\w+)$/\.$2/; + return $symb; +} + # ------------------------------------------------------ Return symb list entry sub symbread { my $thisfn=shift; unless ($thisfn) { - if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; } + if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } $thisfn=$ENV{'request.filename'}; } $thisfn=declutter($thisfn); @@ -2580,7 +2592,7 @@ sub symbread { } } if ($syval) { - return $syval.'___'.$thisfn; + return &symbclean($syval.'___'.$thisfn); } } &appenv('request.ambiguous' => $thisfn);