--- 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("<font color=\"blue\">WARNING: ".
- "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
- "</font>");
- 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("<font color=\"blue\">WARNING: ".
- "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
- "</font>");
- }
-
- if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
- &escape('Checkout '.$infostr.' - '.
- $token)) ne 'ok') {
- return '';
- } else {
- &logthis("<font color=\"blue\">WARNING: ".
- "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
- "</font>");
- }
- 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 *