--- loncom/lonnet/perl/lonnet.pm 2010/03/26 21:27:41 1.1056.2.2 +++ loncom/lonnet/perl/lonnet.pm 2010/03/21 21:05:51 1.1058 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.2.2 2010/03/26 21:27:41 raeburn Exp $ +# $Id: lonnet.pm,v 1.1058 2010/03/21 21:05:51 raeburn 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 { @@ -4624,7 +4539,7 @@ sub get_portfolio_access { my (%allgroups,%allroles); my ($start,$end,$role,$sec,$group); foreach my $envkey (%env) { - if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { + if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { my $cid = $2.'_'.$3; if ($1 eq 'gr') { $group = $4; @@ -6319,6 +6234,7 @@ sub assignrole { if ($role eq 'cc' || $role eq 'co') { %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner')); if (($role eq 'cc') && ($cnum !~ /^$match_community$/)) { + if ($env{'request.role'} eq 'cc./'.$cdom.'/'.$cnum) { if ($crsenv{'internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'}) { @@ -6527,15 +6443,9 @@ sub modifyuser { $forceid, $desiredhome, $email, $inststatus, $candelete)=@_; $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.'; candelete: '.$candelete.')'. (defined($desiredhome) ? ' desiredhome = '.$desiredhome : ' desiredhome not specified'). ' by '.$env{'user.name'}.' at '.$env{'user.domain'}. @@ -6602,8 +6512,9 @@ sub modifyuser { # # 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. +# unless field is in $candelete array ref. # + my @fields = ('firstname','middlename','lastname','generation', 'permanentemail','id'); my %newvalues; @@ -6616,7 +6527,7 @@ sub modifyuser { $names{$field} = $middle; } elsif ($field eq 'lastname') { $names{$field} = $last; - } elsif ($field eq 'generation') { + } elsif ($field eq 'generation') { $names{$field} = $gene; } elsif ($field eq 'permanentemail') { $names{$field} = $email; @@ -6626,7 +6537,6 @@ sub modifyuser { } } } - if ($first) { $names{'firstname'} = $first; } if (defined($middle)) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; } @@ -10359,7 +10269,7 @@ modifyuser($udom,$uname,$uid,$umode,$upa 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 +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.