--- loncom/lonnet/perl/lonnet.pm 2010/03/24 03:29:56 1.1056.2.1 +++ loncom/lonnet/perl/lonnet.pm 2010/03/21 18:31:53 1.1057 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.2.1 2010/03/24 03:29:56 raeburn Exp $ +# $Id: lonnet.pm,v 1.1057 2010/03/21 18:31:53 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3207,7 +3207,7 @@ sub get_domain_roles { return %personnel; } -# ----------------------------------------------------------- Check out an item +# ----------------------------------------------------------- Interval timing sub get_first_access { my ($type,$argsymb)=@_; @@ -3243,91 +3243,6 @@ sub set_first_access { return 'already_set'; } -sub checkout { - my ($symb,$tuname,$tudom,$tcrsid)=@_; - my $now=time; - my $lonhost=$perlvar{'lonHostID'}; - my $infostr=&escape( - 'CHECKOUTTOKEN&'. - $tuname.'&'. - $tudom.'&'. - $tcrsid.'&'. - $symb.'&'. - $now.'&'.$ENV{'REMOTE_ADDR'}); - my $token=&reply('tmpput:'.$infostr,$lonhost); - if ($token=~/^error\:/) { - &logthis("WARNING: ". - "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. - ""); - return ''; - } - - $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/; - $token=~tr/a-z/A-Z/; - - my %infohash=('resource.0.outtoken' => $token, - 'resource.0.checkouttime' => $now, - 'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); - - unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { - return ''; - } else { - &logthis("WARNING: ". - "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. - ""); - } - - if (&log($tudom,$tuname,&homeserver($tuname,$tudom), - &escape('Checkout '.$infostr.' - '. - $token)) ne 'ok') { - return ''; - } else { - &logthis("WARNING: ". - "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. - ""); - } - return $token; -} - -# ------------------------------------------------------------ Check in an item - -sub checkin { - my $token=shift; - my $now=time; - my ($ta,$tb,$lonhost)=split(/\*/,$token); - $lonhost=~tr/A-Z/a-z/; - my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; - $dtoken=~s/\W/\_/g; - my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= - split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); - - unless (($tuname) && ($tudom)) { - &logthis('Check in '.$token.' ('.$dtoken.') failed'); - return ''; - } - - unless (&allowed('mgr',$tcrsid)) { - &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '. - $env{'user.name'}.' - '.$env{'user.domain'}); - return ''; - } - - my %infohash=('resource.0.intoken' => $token, - 'resource.0.checkintime' => $now, - 'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); - - unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { - return ''; - } - - if (&log($tudom,$tuname,&homeserver($tuname,$tudom), - &escape('Checkin - '.$token)) ne 'ok') { - return ''; - } - - return ($symb,$tuname,$tudom,$tcrsid); -} - # --------------------------------------------- Set Expire Date for Spreadsheet sub expirespread { @@ -6524,18 +6439,12 @@ sub modifyuser { my ($udom, $uname, $uid, $umode, $upass, $first, $middle, $last, $gene, - $forceid, $desiredhome, $email, $inststatus, $candelete)=@_; + $forceid, $desiredhome, $email, $inststatus)=@_; $udom= &LONCAPA::clean_domain($udom); $uname=&LONCAPA::clean_username($uname); - my $showcandelete = 'none'; - if (ref($candelete) eq 'ARRAY') { - if (@{$candelete} > 0) { - $showcandelete = join(', ',@{$candelete}); - } - } &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. $umode.', '.$first.', '.$middle.', '. - $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'. + $last.', '.$gene.'(forceid: '.$forceid.')'. (defined($desiredhome) ? ' desiredhome = '.$desiredhome : ' desiredhome not specified'). ' by '.$env{'user.name'}.' at '.$env{'user.domain'}. @@ -6600,33 +6509,9 @@ sub modifyuser { %names = @tmp; } # -# 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. -# - my @fields = ('firstname','middlename','lastname','generation', - 'permanentemail','id'); - my %newvalues; - if (ref($candelete) eq 'ARRAY') { - foreach my $field (@fields) { - if (grep(/^\Q$field\E$/,@{$candelete})) { - if ($field eq 'firstname') { - $names{$field} = $first; - } elsif ($field eq 'middlename') { - $names{$field} = $middle; - } elsif ($field eq 'lastname') { - $names{$field} = $last; - } elsif ($field eq 'generation') { - $names{$field} = $gene; - } elsif ($field eq 'permanentemail') { - $names{$field} = $email; - } elsif ($field eq 'id') { - $names{$field} = $uid; - } - } - } - } - +# Make sure to not trash student environment if instructor does not bother +# to supply name and email information +# if ($first) { $names{'firstname'} = $first; } if (defined($middle)) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; } @@ -10353,16 +10238,9 @@ modifyuserauth($udom,$uname,$umode,$upas =item * -modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last, $gene, - $forceid,$desiredhome,$email,$inststatus,$candelete) : - -will update user information (firstname,middlename,lastname,generation, -permanentemail), and if forceid is true, student/employee ID also. -A user's institutional affiliation(s) can also be updated. -User information fields will not be overwritten with empty entries -unless the field is included in the $candelete array reference. -This array is included when a single user is modified via "Manage Users", -or when Autoupdate.pl is run by cron in a domain. +modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, + $forceid,$desiredhome,$email,$inststatus) : +modify user =item *